home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtdials.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  120.8 KB  |  3,648 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtDials;
  23.  
  24.  
  25. (*----------------------------------------------------------------------*
  26.  * Int. Vers | Datum    | Name | Žnderung                               *
  27.  *-----------+----------+------+----------------------------------------*
  28.  *  3.00     | 18.01.92 |  Hp  |                                        *
  29.  *  3.01     | 22.01.92 |  Hp  | Userobjects in das Modul mtXobjects    *
  30.  *           |          |      | ausgelagert. Damit Weg frei, um in MM2 *
  31.  *           |          |      | richtige Progdef zu realisieren.       *
  32.  *  3.02     | 03.02.92 |  Hp  | PROGDEF-Simulator fr Non-MM2-Compiler *
  33.  *           |          |      | eingebaut.                             *
  34.  *  3.03     | 10.02.92 |      | DeskX und DeskY werden ausgewertet,    *
  35.  *           |          |      | Dadurch einige Aufrufe von Windget     *
  36.  *           |          |      | eingespart...                          *
  37.  *  3.04     | 26.02.92 |  Hp  | Messagepipe bei Userhandler zulassen   *
  38.  *  3.05     | 18.03.92 |  Hp  | Bugfix beim Objekthandling             *
  39.  *-----------+----------+------+----------------------------------------*)
  40.  
  41. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  42. (*                                              *)
  43. (*$R-   Range-Checks                            *)
  44. (*$S-   Stack-Check                             *)
  45. (*                                              *)
  46. (*----------------------------------------------*)
  47.  
  48.  
  49.  
  50. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  51.  
  52.  
  53.  
  54.  
  55. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  56.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  57.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  58.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  59.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  60.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  61.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  62.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  FROM SYSTEM IMPORT ADDRESS, CADR, ADR, TSIZE, CODE, CALLSYS; 
  70.  
  71.  
  72.  
  73. FROM MagicBIOS  IMPORT  KRSHIFT, KLSHIFT, KCTRL, KALT, KCAPS;
  74. FROM MagicVDI   IMPORT  VDIIntIn, VDIIntOut, VDIPtsIn, VDIPtsOut, VDIControl,
  75.                         VDICall, tWorkIn, tWorkOut, MFDB, ShowCursor,
  76.                         HideCursor, SetFillcolor, SetWritemode, Fat, Light,
  77.                         Italic, Underline, Outline, Shadowed, SetTexteffect,
  78.                         SetTextalignment, XOR, REPLACE, TRANSPARENT, Text,
  79.                         SetClipping, SetFillperimeter, InqFaceinfo, 
  80.                         SetCharheight, SetTextcolor, Ellipse, EllipticalArc,
  81.                         SetLinecolor;
  82. FROM MagicAES   IMPORT  GBOX, GTEXT, GBOXTEXT, GIMAGE, GPROGDEF, GIBOX,
  83.                         GBUTTON, GBOXCHAR, GSTRING, GFTEXT, GFBOXTEXT,
  84.                         GICON, GTITLE, SELECTABLE, DEFAULT, Exit, EDITABLE,
  85.                         RBUTTON, LASTOB, TOUCHEXIT, HIDETREE, INDIRECT,
  86.                         SELECTED, CROSSED, CHECKED, DISABLED, OUTLINED,
  87.                         SHADOWED, DRAW3D, WHITEBAK, OBJECT, ObjcAdd, RTREE,
  88.                         RsrcGaddr, EDINIT, EDCHAR, EDEND, (*ObjcEdit,*) ObjcDraw,
  89.                         ObjcFind, BEGMCTRL, ENDMCTRL, WindUpdate, WFFULLXYWH,
  90.                         WindGet, FMDSTART, FMDGROW, FMDSHRINK, FMDFINISH,
  91.                         FormDial, FormCenter, FormKeybd, GrafMkstate, ARROW, 
  92.                         FLATHAND, PtrPARMBLK, Objcspec, GrafMouse, GrafDragbox,
  93.                         GrafHandle, MUKEYBD, MUBUTTON, MUM1, MUM2, MUMESAG, 
  94.                         MUTIMER, AESIntIn, AESIntOut, AESCall, ObjcOffset, 
  95.                         GrafWatchbox;
  96. FROM mtUtils    IMPORT  tRect, tObjcTree, AnyType, InclFlag, ExclFlag, 
  97.                         InFlag, InclState, ExclState, InState, ObjcString,
  98.                         ObjcStringAdr, SetObjcString, SetObjcStringAdr,
  99.                         ObjcStrLen, ObjcPos, ObjcParent, ObjcArea, SetObjcRect,
  100.                         ObjcFrame, CalcArea, ScanFlags, DoubleClick, Bounce,
  101.                         Min, Max, SearchType, SearchFlags, SearchState,
  102.                         AbsRect, SetState, SetFlag;
  103. FROM mtAppl     IMPORT  OpenWorkstation, Bitplanes, MouseOn, MouseOff,
  104.                         MouseBusy, MouseHand, MouseArrow, CharWidth,
  105.                         CharHeight, BoxWidth, BoxHeight, InstallTermproc,
  106.                         PrivateWS, MaxColors, StoreMouse, RestoreMouse,
  107.                         DeskX, DeskY, MaxWidth, MaxHeight, AESFontsize;
  108. FROM mtArea     IMPORT  AREA, NewAREA, DisposeAREA, FreeArea, SaveArea, 
  109.                         CopyArea, RestoreArea, MoveArea;
  110. FROM MagicCookie IMPORT VirtualScreen, FindCookie; 
  111. FROM MagicStrings IMPORT  Assign, Append, Length, Cap, Equal, Pos;
  112. FROM MagicBitOps IMPORT Operation, BitOp;
  113. FROM mtPopups   IMPORT  TreePopup;
  114. FROM mtRsc IMPORT RESOURCE, GaddrRsc, RelocRsc;
  115.  
  116. IMPORT  MagicAES;
  117. IMPORT  MagicVDI;
  118. IMPORT  MagicBIOS;
  119. IMPORT  MagicDOS;
  120. IMPORT  MagicXBIOS;
  121. IMPORT  mtXobjects;
  122.  
  123.  
  124.  
  125.  
  126.  
  127. (*----------------------------------------------------------------------*
  128.  *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *
  129.  *----------------------------------------------------------------------*
  130.  *           Inline-Resource erzeugt am 16.10.1993 17:57:44             *
  131.  *----------------------------------------------------------------------*)
  132.  
  133. TYPE tRscData = ARRAY [0..902] OF CARDINAL;
  134.  
  135. CONST RscData = tRscData {
  136.         00000H, 00030H, 00318H, 00318H, 00318H, 003DCH, 003DCH, 005B8H, 005B8H, 
  137.         00024H, 0001FH, 00003H, 00000H, 00000H, 0000EH, 00000H, 00000H, 00708H, 
  138.         00000H, 00030H, 00000H, 000F0H, 00000H, 001B0H, 0FFFFH, 00001H, 00007H, 
  139.         00014H, 00000H, 00010H, 00002H, 01100H, 00000H, 00000H, 00043H, 00008H, 
  140.         00002H, 0FFFFH, 0FFFFH, 01119H, 00000H, 00010H, 00001H, 01100H, 00041H, 
  141.         00000H, 00002H, 00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 00000H, 00020H, 
  142.         00000H, 003DCH, 00002H, 00A00H, 0000EH, 00001H, 00004H, 0FFFFH, 0FFFFH, 
  143.         0001CH, 00000H, 00000H, 00000H, 003EBH, 00002H, 00002H, 0003FH, 00001H, 
  144.         00005H, 0FFFFH, 0FFFFH, 0001CH, 00000H, 00000H, 00000H, 0042BH, 00002H, 
  145.         00003H, 0003FH, 00001H, 00006H, 0FFFFH, 0FFFFH, 0001CH, 00000H, 00000H, 
  146.         00000H, 0046BH, 00002H, 00004H, 0003FH, 00001H, 00007H, 0FFFFH, 0FFFFH, 
  147.         0001CH, 00000H, 00000H, 00000H, 004ABH, 00002H, 00005H, 0003FH, 00001H, 
  148.         00000H, 0FFFFH, 0FFFFH, 0001CH, 00020H, 00000H, 00000H, 004EBH, 00002H, 
  149.         00006H, 0003FH, 00001H, 0FFFFH, 00001H, 00007H, 00014H, 00000H, 00020H, 
  150.         000FFH, 01100H, 00000H, 00000H, 00016H, 00008H, 00002H, 0FFFFH, 0FFFFH, 
  151.         0001CH, 00001H, 00000H, 00000H, 0052BH, 00000H, 00000H, 00016H, 00001H, 
  152.         00003H, 0FFFFH, 0FFFFH, 0001CH, 00001H, 00000H, 00000H, 0053EH, 00000H, 
  153.         00001H, 00016H, 00001H, 00004H, 0FFFFH, 0FFFFH, 0001CH, 00001H, 00000H, 
  154.         00000H, 00552H, 00000H, 00002H, 00016H, 00001H, 00005H, 0FFFFH, 0FFFFH, 
  155.         0001CH, 00001H, 00000H, 00000H, 00567H, 00000H, 00003H, 00016H, 00001H, 
  156.         00006H, 0FFFFH, 0FFFFH, 0001CH, 00001H, 00000H, 00000H, 0057AH, 00000H, 
  157.         00005H, 00016H, 00001H, 00007H, 0FFFFH, 0FFFFH, 0001CH, 00001H, 00000H, 
  158.         00000H, 0058CH, 00000H, 00006H, 00016H, 00001H, 00000H, 0FFFFH, 0FFFFH, 
  159.         0001CH, 00021H, 00000H, 00000H, 005A3H, 00000H, 00007H, 00016H, 00001H, 
  160.         0FFFFH, 00001H, 0000EH, 00014H, 00000H, 00000H, 000FFH, 01100H, 00000H, 
  161.         00000H, 0001AH, 00005H, 00002H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  162.         00000H, 00318H, 00002H, 00001H, 00002H, 00001H, 00003H, 0FFFFH, 0FFFFH, 
  163.         00017H, 00000H, 00000H, 00000H, 00326H, 00005H, 00001H, 00002H, 00001H, 
  164.         00004H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 00334H, 00009H, 
  165.         00001H, 00002H, 00001H, 00005H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  166.         00000H, 00342H, 0000CH, 00001H, 00002H, 00001H, 00006H, 0FFFFH, 0FFFFH, 
  167.         00017H, 00000H, 00000H, 00000H, 00350H, 00010H, 00001H, 00002H, 00001H, 
  168.         00007H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 0035EH, 00013H, 
  169.         00001H, 00002H, 00001H, 00008H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  170.         00000H, 0036CH, 00016H, 00001H, 00002H, 00001H, 00009H, 0FFFFH, 0FFFFH, 
  171.         00017H, 00000H, 00000H, 00000H, 0037AH, 00002H, 00003H, 00002H, 00800H, 
  172.         0000AH, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 00388H, 00005H, 
  173.         00003H, 00002H, 00800H, 0000BH, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  174.         00000H, 00396H, 00009H, 00003H, 00002H, 00800H, 0000CH, 0FFFFH, 0FFFFH, 
  175.         00017H, 00000H, 00000H, 00000H, 003A4H, 0000CH, 00003H, 00002H, 00800H, 
  176.         0000DH, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 003B2H, 00010H, 
  177.         00003H, 00002H, 00800H, 0000EH, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  178.         00000H, 003C0H, 00013H, 00003H, 00002H, 00800H, 00000H, 0FFFFH, 0FFFFH, 
  179.         00017H, 00020H, 00000H, 00000H, 003CEH, 00016H, 00003H, 00002H, 00800H, 
  180.         00000H, 005B8H, 00002H, 00010H, 00000H, 00000H, 00001H, 00000H, 005D8H, 
  181.         00002H, 00010H, 00000H, 00000H, 00001H, 00000H, 005F8H, 00002H, 00010H, 
  182.         00000H, 00000H, 00001H, 00000H, 00618H, 00002H, 00010H, 00000H, 00000H, 
  183.         00001H, 00000H, 00638H, 00002H, 00010H, 00000H, 00000H, 00001H, 00000H, 
  184.         00658H, 00002H, 00010H, 00000H, 00000H, 00001H, 00000H, 00678H, 00002H, 
  185.         00010H, 00000H, 00000H, 00001H, 00000H, 00698H, 00002H, 00008H, 00000H, 
  186.         00000H, 00001H, 00000H, 006A8H, 00002H, 00008H, 00000H, 00000H, 00001H, 
  187.         00000H, 006B8H, 00002H, 00008H, 00000H, 00000H, 00001H, 00000H, 006C8H, 
  188.         00002H, 00008H, 00000H, 00000H, 00001H, 00000H, 006D8H, 00002H, 00008H, 
  189.         00000H, 00000H, 00001H, 00000H, 006E8H, 00002H, 00008H, 00000H, 00000H, 
  190.         00001H, 00000H, 006F8H, 00002H, 00008H, 00000H, 00000H, 00001H, 05A65H, 
  191.         06963H, 06865H, 06E61H, 07573H, 07761H, 0686CH, 0007FH, 02001H, 02002H, 
  192.         02003H, 02004H, 02005H, 02006H, 02007H, 02008H, 02009H, 0200AH, 0200BH, 
  193.         0200CH, 0200DH, 0200EH, 0200FH, 02010H, 02011H, 02012H, 02013H, 02014H, 
  194.         02015H, 02016H, 02017H, 02018H, 02019H, 0201AH, 0201BH, 0201CH, 0201DH, 
  195.         0201EH, 0201FH, 00080H, 02081H, 02082H, 02083H, 02084H, 02085H, 02086H, 
  196.         02087H, 02088H, 02089H, 0208AH, 0208BH, 0208CH, 0208DH, 0208EH, 0208FH, 
  197.         02090H, 02091H, 02092H, 02093H, 02094H, 02095H, 02096H, 02097H, 02098H, 
  198.         02099H, 0209AH, 0209BH, 0209CH, 0209DH, 0209EH, 0209FH, 000A0H, 020A1H, 
  199.         020A2H, 020A3H, 020A4H, 020A5H, 020A6H, 020A7H, 020A8H, 020A9H, 020AAH, 
  200.         020ABH, 020ACH, 020ADH, 020AEH, 020AFH, 020B0H, 020B0H, 020B2H, 020B3H, 
  201.         020B4H, 020B5H, 020B6H, 020B7H, 020B8H, 020B9H, 020BAH, 020BBH, 020BCH, 
  202.         020BDH, 020BEH, 020BFH, 000C0H, 020C1H, 020C2H, 020C3H, 020C4H, 020C5H, 
  203.         020C6H, 020C7H, 020C8H, 020C9H, 020CAH, 020CBH, 020CCH, 020CDH, 020CEH, 
  204.         020CFH, 020D0H, 020D1H, 020D2H, 020D3H, 020D4H, 020D5H, 020D6H, 020D7H, 
  205.         020D8H, 020D9H, 020DAH, 020DBH, 020DCH, 020DDH, 020DEH, 020DFH, 000E0H, 
  206.         020E1H, 020E2H, 020E3H, 020E4H, 020E5H, 020E6H, 020E7H, 020E8H, 020E9H, 
  207.         020EAH, 020EBH, 020ECH, 020EDH, 020EEH, 020EFH, 020F0H, 020F1H, 020F2H, 
  208.         020F3H, 020F4H, 020F5H, 020F6H, 020F7H, 020F8H, 020F9H, 020FAH, 020FBH, 
  209.         020FCH, 020FDH, 020FEH, 020FFH, 00020H, 02041H, 07573H, 06C94H, 07365H, 
  210.         06E20H, 06D69H, 07420H, 0414CH, 05400H, 02020H, 04175H, 0736CH, 09473H, 
  211.         0656EH, 0206DH, 06974H, 02043H, 05452H, 04C00H, 02020H, 0536FH, 06C69H, 
  212.         06465H, 02076H, 06572H, 07363H, 06869H, 06562H, 0656EH, 00020H, 02045H, 
  213.         07277H, 06569H, 07465H, 07274H, 06573H, 02045H, 06469H, 07400H, 02020H, 
  214.         0616EH, 0204DH, 06175H, 07370H, 06F73H, 06974H, 0696FH, 06E00H, 02020H, 
  215.         0616EH, 0206CH, 06574H, 07A74H, 06572H, 02050H, 06F73H, 06974H, 0696FH, 
  216.         06E20H, 00020H, 02047H, 0726FH, 0772DH, 02F53H, 06872H, 0696EH, 06B62H, 
  217.         06F78H, 0656EH, 00000H, 00000H, 07FFEH, 04002H, 04002H, 04002H, 04002H, 
  218.         04002H, 04002H, 04002H, 04002H, 04002H, 04002H, 04002H, 04002H, 07FFEH, 
  219.         00000H, 00000H, 07FFEH, 06006H, 0500AH, 04812H, 04422H, 04242H, 04182H, 
  220.         04182H, 04242H, 04422H, 04812H, 0500AH, 06006H, 07FFEH, 00000H, 00000H, 
  221.         003C0H, 00C30H, 01008H, 02004H, 02004H, 04002H, 04002H, 04002H, 04002H, 
  222.         02004H, 02004H, 01008H, 00C30H, 003C0H, 00000H, 00000H, 003C0H, 00C30H, 
  223.         01008H, 023C4H, 027E4H, 04FF2H, 04FF2H, 04FF2H, 04FF2H, 027E4H, 023C4H, 
  224.         01008H, 00C30H, 003C0H, 00000H, 00000H, 00000H, 023C0H, 03C30H, 03808H, 
  225.         03C08H, 00004H, 02004H, 02004H, 02000H, 0103CH, 0101CH, 00C3CH, 003C4H, 
  226.         00000H, 00000H, 0FFFFH, 0FFFFH, 0DC3FH, 0C3CFH, 0C7F7H, 0C3F7H, 0FFFBH, 
  227.         0DFFBH, 0DFFBH, 0DFFFH, 0EFC3H, 0EFE3H, 0F3C3H, 0FC3BH, 0FFFFH, 0FFFFH, 
  228.         00000H, 07FFEH, 05112H, 04002H, 04446H, 04002H, 05112H, 04002H, 04446H, 
  229.         04002H, 05112H, 06002H, 04446H, 04002H, 07FFEH, 00000H, 07FFEH, 04002H, 
  230.         04002H, 04002H, 04002H, 04002H, 07FFEH, 00000H, 07FFEH, 0700EH, 04C32H, 
  231.         043C2H, 04C32H, 0700EH, 07FFEH, 00000H, 01FF8H, 02004H, 04002H, 04002H, 
  232.         04002H, 02004H, 01FF8H, 00000H, 01FF8H, 02004H, 04FF2H, 05FFAH, 04FF2H, 
  233.         02004H, 01FF8H, 00000H, 027E0H, 03818H, 03804H, 03C00H, 0003CH, 0201CH, 
  234.         0181CH, 007E4H, 0D01FH, 0C7E7H, 0C7FBH, 0C3FFH, 0FFC3H, 0DFE3H, 0E7E3H, 
  235.         0F81BH, 07FFEH, 04002H, 0488AH, 04002H, 06222H, 04002H, 07FFEH, 00000H, 
  236.         00000H, 00000H, 00000H
  237.         }; (* Ende RscData *)
  238. (*----------------------------------------------------------------------*)
  239.  
  240. CONST   ShortCut =      '[';    (* Zeichen das dem Shortcut vorausgeht *)
  241.         toScreen =      TRUE;
  242.         toRAM =         FALSE;
  243.         MaxKeys =       255;
  244.  
  245. CONST   (* 
  246.         UndoButton =    14;     (* Flag 14 kennzeichnet einen Undobutton *)
  247.         HelpButton =    15;     (* Flag 15 kennzeichnet einen Helpbutton *)
  248.         *)
  249.         cCoords    =    13;     (* Flag 13 kennzeichnet Objekte mit gefixten Koordinaten *)
  250.         (*
  251.         LongEdit =      24;     (* Erweiterter Objekttyp fr lange Editfelder *)
  252.         *)
  253.  
  254. CONST   MLinks =        Bit0;
  255.         MRechts =       Bit1;
  256.  
  257. CONST   cMove =         Bit0; (* Dialog ist verschiebbar *)
  258.         cRestore =      Bit1; (* DDISABLE wurde aufgerufen *)
  259.         cUser =         Bit2; (* Userhandler ist installiert *)
  260.  
  261. TYPE    Userkey =       RECORD
  262.                          object:  sINTEGER;
  263.                          scan:    sINTEGER;
  264.                          kbstate: sBITSET;
  265.                          action:  BOOLEAN;
  266.                         END;
  267.  
  268. TYPE    Keylist =       ARRAY [0..MaxKeys] OF Userkey;
  269.                         (* Liste der Shortcuts und Userkeys, die der Dialog
  270.                          * kennt und verwaltet
  271.                          *)
  272.  
  273. TYPE    DIALOG =        POINTER TO Dialog;
  274.         Dialog =        RECORD
  275.                          tree:  tObjcTree;   (* Objektbaum des Dialogs *)
  276.                          back:  AREA;        (* Hintergrund *)
  277.                          front: AREA;        (* Vordergrund *)
  278.                          keys:  Keylist;     (* Liste der Tastencodes *)
  279.                          flags: sBITSET;     (* Zustandsflags *)
  280.                          proc:  UserHandler; (* UserHandler *)
  281.                          pmode: sINTEGER;    (* Modus des Handlers *)
  282.                          ptime: sINTEGER;    (* Timerwert *)
  283.                          prmod: sINTEGER;    (* Rechteckmodus *)
  284.                          prect: tRect;       (* Rechteck *)
  285.                          pmess: ADDRESS;     (* Adresse des Messagepuffers *)
  286.                          next:  DIALOG;      (* N„chster Dialog in der Kette *)
  287.                         END;
  288.  
  289. VAR     Tastatur:       MagicXBIOS.PtrKEYTAB;  (* Zeiger auf Tastaturtabelle *)
  290.  
  291. VAR     scancodes:      ARRAY [48..90] OF sINTEGER;
  292.                         (* Tabelle der Scancodes anhand des ASCII-Zeichens *)
  293.  
  294. VAR     Config:         sBITSET;   (* Globales Config-Flagset           *)
  295.         ROffset:        sINTEGER;  (* Offset fr Radio- und Checkbutton *)
  296.         ChSize:         sINTEGER;  (* Default-Fontgr”že in PIXEL        *)
  297.         ChWidth:        sINTEGER;  (* Default-Zeichenbreite in PIXEL    *)
  298.         kbshift:        sBITSET;   (* Globaler Tastaturstatus           *)
  299.         ScreenMFDB:     MFDB;      (* MFDB fr Bildschirm               *)
  300.         area:           AREA;      (* AREA fr dies und das             *)
  301.         screen:         tRect;     (* Ausmaže des gesamten Schirms      *)
  302.         bound:          tRect;     (* Fl„che des Desktops               *)
  303.         small:          tRect;     (* Default-Rechteck mit Gr”že Null   *)
  304.         clip:           tRect;     (* Clipping-Rechteck                 *)
  305.         dummy:          tRect;     (* Zur allgemeinen Verwendung        *)
  306.         ShortKey:       sBITSET;   (* Aktuelle Ausl”setaste (ALT/CTRL)  *)
  307.         Dials:          DIALOG;    (* Liste der Dialoge                 *)
  308.         asciitab:       tObjcTree; (* Dialog fr Nicht-Tastatur Zeichen *)
  309.         confdial:       tObjcTree; (* Konfigurations-Popupmen          *)
  310.         init:           sCARDINAL; (* Init-Variable                     *)
  311.         mode3D:         BOOLEAN;   (* 3D-Modus An/Aus                   *)
  312.         rscData:        POINTER TO tRscData;    (* Buffer fr interne Resource *)
  313.  
  314. VAR     mKnopf:         ARRAY [FALSE..TRUE] OF ADDRESS; (* Runder Knopf *)
  315.         mSelect:        ARRAY [FALSE..TRUE] OF ADDRESS; (* Ankreuzbox *)
  316.         mCircle:        ARRAY [FALSE..TRUE] OF ADDRESS; (* Circlebutton *)
  317.         (* Wie oben jedoch fr Aufl”sungen *)
  318.         fKnopf:         ARRAY [FALSE..TRUE] OF ADDRESS;
  319.         fSelect:        ARRAY [FALSE..TRUE] OF ADDRESS;
  320.         fCircle:        ARRAY [FALSE..TRUE] OF ADDRESS;
  321.         mPunktEin:      ADDRESS;
  322.         fPunktEin:      ADDRESS;
  323.  
  324. (* Allgemeine Variable *)
  325.  
  326. VAR     msgBuff:        ARRAY [0..7] OF sINTEGER;
  327.         mrect:          tRect;
  328.         mX, mY:         sINTEGER;
  329.         button:         sBITSET;
  330.         taste:          sINTEGER;
  331.         scan:           sINTEGER;
  332.         clicks:         sINTEGER;
  333.         ascii, ch:      CHAR;
  334.         event:          sBITSET;
  335.         control7:       POINTER TO ADDRESS; (* it's tricky... *)
  336.         control9:       POINTER TO ADDRESS;
  337.         at:             AnyType;
  338.         (* Fr lange Editfelder *)
  339.         theText:        ARRAY [0..1023] OF CHAR;
  340.         
  341.         IsMagiCScroll:  BOOLEAN;        (* MagiC handelt lange Editfelder *)
  342.         lastPos:        sINTEGER;
  343.  
  344.  
  345. VAR     dialDo:         DialDoProc;     (* Functionpointer to DialDo *)
  346.  
  347.  
  348. (*----------------------------------------------------------------------*)
  349.  
  350.  
  351.   VAR conterm[0484H]: ByteSet;  
  352.  
  353.  
  354.  
  355. PROCEDURE Glocke;
  356. CONST glocke = 2;
  357. VAR   stack:   ADDRESS;
  358. BEGIN
  359.  stack:= 0;  MagicDOS.Super (stack);
  360.  
  361.  
  362.  
  363.  
  364.   IF (glocke IN conterm) THEN  MagicBIOS.Bconout (MagicBIOS.CON, CHR(7));  END;
  365.  
  366.  MagicDOS.Super (stack);
  367. END Glocke;
  368.  
  369. PROCEDURE GetKeytable (): MagicXBIOS.PtrKEYTAB;
  370. VAR tb: ADDRESS;
  371. BEGIN
  372.  tb:= Nil;  RETURN MagicXBIOS.Keytbl (tb, tb, tb);
  373. END GetKeytable;
  374.  
  375. PROCEDURE DialConfig (flag: sINTEGER; set: BOOLEAN);
  376. BEGIN
  377.  IF set THEN  INCL (Config, flag);  ELSE  EXCL (Config, flag);  END;
  378.  IF (UseALT IN Config) THEN ShortKey:= {KALT} ELSE ShortKey:= {KCTRL} END;
  379. END DialConfig;
  380.  
  381. PROCEDURE GetDialConfig (): sBITSET;
  382. BEGIN
  383.  RETURN Config;
  384. END GetDialConfig;
  385.  
  386. PROCEDURE GetKbdState (): sBITSET;
  387. BEGIN
  388.  RETURN kbshift;
  389. END GetKbdState;
  390.  
  391. PROCEDURE GetDIALOG (tree: ADDRESS): DIALOG;
  392. VAR (*$Reg*)  p: DIALOG;
  393. BEGIN
  394.  p:= Dials;
  395.  WHILE p # NIL DO
  396.   IF p^.tree = tree THEN  RETURN p;  END;
  397.   p:= p^.next;
  398.  END;
  399.  RETURN NIL;
  400. END GetDIALOG;
  401.  
  402. (*-----------------------------------------------------------------------*)
  403.  
  404. PROCEDURE SetUserkey (tree: ADDRESS; object, scan: sINTEGER;
  405.                       kbstate: sBITSET; action, set: BOOLEAN);
  406. VAR dial: DIALOG;
  407.     (*$Reg*)  i: sINTEGER;
  408.     eol: BOOLEAN;
  409.  
  410.  PROCEDURE FindUserKey (): sINTEGER;
  411.  VAR i: sINTEGER;
  412.  BEGIN
  413.   FOR i:= 0 TO MaxKeys DO
  414.    IF (dial^.keys[i].scan = -1) THEN  RETURN -1;  END;
  415.    IF (dial^.keys[i].object = object) AND
  416.       (dial^.keys[i].scan = scan) AND 
  417.       (dial^.keys[i].kbstate = kbstate) THEN  RETURN i;  END;
  418.   END; (* FOR *)
  419.  END FindUserKey;
  420.  
  421. BEGIN
  422.  dial:= GetDIALOG (tree);
  423.  IF (dial = NIL) (* Kein gltiger Dialog *) OR
  424.     (scan = 0) (* Kein gltiger Scancode *) THEN  RETURN;  END;
  425.  i:= 0;
  426.  IF set THEN (* Tastatureintrag machen *)
  427.   (* Testen, ob nicht schon eingetragen *)
  428.   IF FindUserKey () >= 0 THEN  RETURN;  END;
  429.  
  430.   (* Freien Eintrag suchen. Freie Eintr„ge sind mit Scancode 0 gekennzeichnet,
  431.    * das Ende der Liste wird durch Scancode -1 erkannt.
  432.    *)
  433.   WHILE dial^.keys[i].scan > 0 DO  INC (i);  END;
  434.   IF i < MaxKeys THEN (* Letzen Eintrag fr EndOfList freihalten *)
  435.    (* Bei Shift-Tasten nicht unterscheiden *)
  436.    IF (Bit0 IN kbstate) OR (Bit1 IN kbstate) THEN
  437.     kbstate:= kbstate + {Bit0, Bit1};
  438.    END;
  439.    eol:= dial^.keys[i].scan = -1;
  440.    dial^.keys[i].object:= object;
  441.    dial^.keys[i].scan:= scan;
  442.    dial^.keys[i].kbstate:= kbstate;
  443.    dial^.keys[i].action:= action;
  444.    IF eol THEN (* Neues EndOfList *)  dial^.keys[i + 1].scan:= -1;  END;
  445.   END; 
  446.  
  447.  ELSE (* Tastatureintrag l”schen *)
  448.   i:= FindUserKey ();
  449.   IF i >= 0 THEN
  450.    dial^.keys[i].object:= -1;
  451.    dial^.keys[i].scan:= 0;
  452.    dial^.keys[i].kbstate:= {};
  453.   END;
  454.  END; (* IF *)
  455. END SetUserkey;
  456.  
  457. PROCEDURE ResetUserkeys (tree: ADDRESS);
  458. VAR (*$Reg*)  q: DIALOG;
  459.     (*$Reg*)  i: sINTEGER;
  460. BEGIN
  461.  q:= GetDIALOG (tree);
  462.  FOR i:= 0 TO MaxKeys DO (* Tastaturliste l”schen *)
  463.   q^.keys[i].object:= -1;
  464.   q^.keys[i].scan:= -1;
  465.   q^.keys[i].kbstate:= {};
  466.  END;
  467. END ResetUserkeys;
  468.  
  469. (*-----------------------------------------------------------------------*)
  470.  
  471. PROCEDURE ObjcExtype (tree: ADDRESS; entry, extyp: sINTEGER);
  472. VAR (*$Reg*)  o: tObjcTree;
  473. BEGIN
  474.  o:= tree;
  475.  IF o^[entry].obType # GPROGDEF THEN 
  476.   at.lint:= o^[entry].obType;
  477.   at.b2:= CastToByte (extyp);
  478.   o^[entry].obType:= at.lint;
  479.  END;
  480. END ObjcExtype;
  481.  
  482. PROCEDURE GetObjcExtype (tree: ADDRESS; entry: sINTEGER;
  483.                          VAR extyp, typ: sINTEGER);
  484. BEGIN
  485.  at.lint:= mtXobjects.GetObtype (tree, entry);
  486.  extyp:= CastToInt (at.b2);
  487.  typ:= CastToInt (at.b1);
  488. END GetObjcExtype;
  489.  
  490. PROCEDURE GetLowbyte (value: sINTEGER): sINTEGER;
  491. VAR t: AnyType;
  492. BEGIN
  493.  t.lint:= value;  RETURN  CastToInt (t.b1);
  494. END GetLowbyte;
  495.  
  496. (*----------------------------------------------------------------------*
  497.  *                   Zeichenroutinen unabh„ngig vom Objekt              *
  498.  *----------------------------------------------------------------------*)
  499.  
  500. PROCEDURE Rect (x, y, w, h, color: sINTEGER);
  501. (* Zeichnet eine Rechteckfl„che *)
  502. VAR i: sINTEGER;
  503. BEGIN
  504.  i:= SetFillcolor (PrivateWS, color);
  505.  VDIPtsIn[0]:= x;
  506.  VDIPtsIn[1]:= y;
  507.  VDIPtsIn[2]:= x + w;
  508.  VDIPtsIn[3]:= y + h;
  509.  VDICall(11, 2, 0, 1, PrivateWS);
  510.  IF color # 0 THEN  i:= SetFillcolor (PrivateWS, 0);  END;
  511. END Rect;
  512.  
  513. PROCEDURE Line (x, y, w, h: sINTEGER);
  514. BEGIN
  515.  VDIPtsIn[0]:= x;
  516.  VDIPtsIn[1]:= y;
  517.  VDIPtsIn[2]:= x + w;
  518.  VDIPtsIn[3]:= y + h;
  519.  VDICall(6, 2, 0, 0, PrivateWS);
  520. END Line;
  521.  
  522. PROCEDURE Frame (x, y, w, h, times: sINTEGER);
  523. (* Zeichnet einen Rahmen, times bestimmt die Dicke *)
  524. VAR i: sINTEGER;
  525.     (*$Reg*)  a: sINTEGER;
  526.     b: sINTEGER;
  527. BEGIN
  528.  a:= 0;  b:= 0;
  529.  FOR i:= 1 TO times DO
  530.   DEC (x);  DEC (y);  INC (w, 2);  INC (h, 2);
  531.   VDIPtsIn[0 + a]:= x;
  532.   VDIPtsIn[1 + a]:= y;
  533.   VDIPtsIn[2 + a]:= x + w;
  534.   VDIPtsIn[3 + a]:= y;
  535.   VDIPtsIn[4 + a]:= VDIPtsIn[2 + a]; (* x + w - 1; *)
  536.   VDIPtsIn[5 + a]:= y + h;
  537.   VDIPtsIn[6 + a]:= x;
  538.   VDIPtsIn[7 + a]:= VDIPtsIn[5 + a]; (* y + h - 1; *)
  539.   VDIPtsIn[8 + a]:= x;
  540.   VDIPtsIn[9 + a]:= y;
  541.   INC (a, 10);  INC (b, 5);
  542.  END;
  543.  VDICall(6, b, 0, 0, PrivateWS);
  544. END Frame;
  545.  
  546. PROCEDURE Frame3D (x, y, w, h, times, hCol, dCol: sINTEGER);
  547. (* Zeichnet einen Rahmen, times bestimmt die Dicke *)
  548. VAR i: sINTEGER;
  549.     (*$Reg*)  a: sINTEGER;
  550.     b: sINTEGER;
  551. BEGIN
  552.  a:= 0;  b:= 0;
  553.  FOR i:= 1 TO times DO
  554.   DEC (x);  DEC (y);  INC (w, 2);  INC (h, 2);
  555.   (* Farbe oben und links setzen *)
  556.   a := SetLinecolor (PrivateWS, hCol);
  557.   (* links *)
  558.   VDIPtsIn[0]:= x;
  559.   VDIPtsIn[1]:= y + h; (* y + h - 1; *)
  560.   VDIPtsIn[2]:= x;
  561.   VDIPtsIn[3]:= y;
  562.   (* oben *)
  563.   VDIPtsIn[4]:= x + w;
  564.   VDIPtsIn[5]:= y;
  565.   VDICall(6, 3, 0, 0, PrivateWS);
  566.   
  567.   (* Farbe rechts und unten setzen *)
  568.   a := SetLinecolor (PrivateWS, dCol);
  569.   (* rechts *)
  570.   VDIPtsIn[0]:= x + w; (* x + w - 1; *)
  571.   VDIPtsIn[1]:= y;
  572.   VDIPtsIn[2]:= x + w;
  573.   VDIPtsIn[3]:= y + h;
  574.   (* unten *)
  575.   VDIPtsIn[4]:= x;
  576.   VDIPtsIn[5]:= y + h;
  577.   VDICall(6, 3, 0, 0, PrivateWS);
  578.  END;
  579.  a := SetLinecolor (PrivateWS, 1);
  580. END Frame3D;
  581.  
  582.  
  583. PROCEDURE Circle (x, y, w, h: sINTEGER; fillColor: INTEGER; fill: BOOLEAN);
  584. (* Zeichnet einen Kreis, color bestimmt die Farbe *)
  585. VAR i: sINTEGER;
  586.     (*$Reg*)  a: sINTEGER;
  587.     b: BOOLEAN;
  588. BEGIN
  589.   b:= MagicVDI.SetFillperimeter (PrivateWS, TRUE); (* Mit Rand *)
  590.   i:= MagicVDI.SetFillcolor (PrivateWS, fillColor); (* Fllfarbe *)
  591.   IF ~fill
  592.   THEN 
  593.     i:= MagicVDI.SetFillinterior (PrivateWS, 0);     (* Nicht fllen *)
  594.   ELSE
  595.     i:= MagicVDI.SetFillinterior (PrivateWS, 1);     (* Fllen *)
  596.   END;
  597.   Ellipse (PrivateWS, x+ (w DIV 2), y + (h DIV 2), w DIV 2, h DIV 2);
  598.   i:= MagicVDI.SetFillcolor (PrivateWS, 0); (* Fllfarbe weiž *)
  599.   b:= MagicVDI.SetFillperimeter (PrivateWS, FALSE); (* Kein Rand *)
  600.   i:= MagicVDI.SetFillinterior (PrivateWS, 1);     (* fllen *)
  601. END Circle;
  602.  
  603. PROCEDURE Circle3D (x, y, w, h: sINTEGER; sel: BOOLEAN);
  604. CONST   upperRightRadius = 450;
  605.         lowerLeftRadius  = 2200;
  606. VAR midX, midY, 
  607.     radX, radY : INTEGER;
  608.     (*$Reg*)  a: sINTEGER;
  609.     b: BOOLEAN;
  610.     col1, col2,
  611.     col3, col4  : INTEGER;
  612. BEGIN
  613.   (* Zeichnet einen kompletten 3D-Radiobutton *)
  614.   (* Mittelpunkt und Radien bestimmen *)
  615.   midX := x + (w DIV 2);
  616.   midY := y + (h DIV 2);
  617.   radX := w DIV 2; IF ODD (w) THEN INC (radX); END;
  618.   radY := h DIV 2; IF ODD (h) THEN INC (radY); END;
  619.   b:= MagicVDI.SetFillperimeter (PrivateWS, TRUE); (* Mit Rand *)
  620.   a:= MagicVDI.SetFillinterior (PrivateWS, 0);     (* Nicht fllen *)
  621.   IF ~sel
  622.   THEN
  623.     col1 := 9; (* links oben aužen *)
  624.     col2 := 0; (* links oben innen *)
  625.     col3 := 9; (* rechts unten innen *)
  626.     col4 := 1; (* rechts unten aužen *)
  627.   ELSE
  628.     col1 := 1; (* links oben aužen *)
  629.     col2 := 9; (* links oben innen *)
  630.     col3 := 0; (* rechts unten innen *)
  631.     col4 := 9; (* rechts unten aužen *)
  632.   END;
  633.   (* Jetzt vier B”gen mit den Farben zeichnen *)
  634.   a := SetLinecolor (PrivateWS, col1);
  635.   EllipticalArc (PrivateWS, midX, midY, radX+1, radY+1, upperRightRadius, lowerLeftRadius);
  636.   a := SetLinecolor (PrivateWS, col2);
  637.   EllipticalArc (PrivateWS, midX, midY, radX, radY, upperRightRadius, lowerLeftRadius);
  638.   a := SetLinecolor (PrivateWS, col3);
  639.   EllipticalArc (PrivateWS, midX, midY, radX, radY, lowerLeftRadius, upperRightRadius);
  640.   a := SetLinecolor (PrivateWS, col4);
  641.   EllipticalArc (PrivateWS, midX, midY, radX+1, radY+1, lowerLeftRadius, upperRightRadius);
  642.   IF sel
  643.   THEN
  644.     a:= MagicVDI.SetFillinterior (PrivateWS, 1);     (* Fllen *)
  645.     a:= MagicVDI.SetFillcolor (PrivateWS, 1); (* Fllfarbe *)
  646.     Ellipse (PrivateWS, midX, midY, 2, 2);
  647.   END;
  648.   a := MagicVDI.SetFillcolor (PrivateWS, 0); (* Fllfarbe weiž *)
  649.   b := MagicVDI.SetFillperimeter (PrivateWS, FALSE); (* Kein Rand *)
  650.   a := MagicVDI.SetFillinterior (PrivateWS, 1);     (* fllen *)
  651.   a := SetLinecolor (PrivateWS, 1);
  652. END Circle3D;
  653.  
  654. TYPE    ButtonType =    (circle, radio, other);
  655.  
  656. PROCEDURE Image (x, y: sINTEGER; typ: ButtonType; sel: BOOLEAN; check : BOOLEAN);
  657. (* Bringt die Images auf den Bildschirm *)
  658. VAR m: MFDB;
  659.     h: sINTEGER;
  660. BEGIN
  661.  IF (CharHeight = 16) OR (CharHeight = 8)
  662.  THEN
  663.    (* Fertige Images blitten *)
  664.    IF typ = circle THEN
  665.     IF CharHeight < 16 THEN  h:=  7;  m.fdAddr:= fCircle[sel];  
  666.                        ELSE  h:= 15;  m.fdAddr:= mCircle[sel];
  667.     END;
  668.    ELSIF typ = radio THEN
  669.     IF CharHeight < 16 THEN  h:=  7;  m.fdAddr:= fKnopf[sel];
  670.                        ELSE  h:= 15;  m.fdAddr:= mKnopf[sel];
  671.     END;
  672.    ELSE
  673.     IF CharHeight < 16 THEN  h:=  7;  IF check & sel THEN m.fdAddr := fPunktEin ELSE m.fdAddr:= fSelect[sel]; END;
  674.                        ELSE  h:= 15;  IF check & sel THEN m.fdAddr := mPunktEin ELSE m.fdAddr:= mSelect[sel]; END;
  675.     END;
  676.    END;
  677.    m.fdW:= 16;
  678.    m.fdH:= h;
  679.    m.fdWdwidth:= 1;
  680.    m.fdStand:= 0;
  681.    m.fdNplanes:= 1; (* Image hat nur eine Bitplane! *)
  682.    Rect (x, y, 16, h-1, 0); (* Vorl”schen *)
  683.    VDIPtsIn[0]:= 0;
  684.    VDIPtsIn[1]:= 0;
  685.    VDIPtsIn[2]:= 15;
  686.    VDIPtsIn[3]:= h;
  687.    VDIPtsIn[4]:= x;
  688.    VDIPtsIn[5]:= y;
  689.    VDIPtsIn[6]:= x + 15;
  690.    VDIPtsIn[7]:= y + h-1;
  691.    control7^:= ADR(m);
  692.    control9^:= ADR(ScreenMFDB);
  693.    VDIIntIn[0]:= 3;
  694.    VDIIntIn[1]:= 1;
  695.    VDIIntIn[2]:= 0;
  696.    VDICall (121, 4, 3, 0, PrivateWS);  (* RasterTransparent *)
  697.  ELSE
  698.    Rect (x, y, CharWidth*2, CharHeight-1, 0); (* Vorl”schen *)
  699.    IF typ = circle 
  700.    THEN
  701.      (* CircleButton zeichnen: Rechteck und darin Downarrow *)
  702.      Frame (x, y, CharWidth*2, CharHeight-1, 1);
  703.      Text (PrivateWS, x+CharWidth DIV 2, y+1, 02c+0c);
  704.      IF sel THEN
  705.        h:= SetWritemode (PrivateWS, XOR);
  706.        Rect (x+1, y+1, CharWidth*2 -2, Max (CharHeight - 3, 1), 1);     (* Invert *)
  707.        h:= SetWritemode (PrivateWS, REPLACE);
  708.      END;
  709.    ELSIF typ = radio
  710.    THEN
  711.      (* Radiobutton: Bei Gr”žen < 12 Punkt Rechteck Outlined und Innenfl„che gefllt oder nicht, 
  712.       *              ansonsten Kreise zeichnen 
  713.       *)
  714.      IF (CharHeight < 12)
  715.      THEN
  716.        Frame (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1);
  717.        Frame (x+4, y+4, Max (CharWidth*2-8, 1), Max (CharHeight-8, 1), 1);
  718.        IF sel
  719.        THEN
  720.          (* Fllen *)
  721.          Rect (x+4, y+4, Max (CharWidth*2-8, 1), Max (CharHeight-8, 1), 1);
  722.        END;
  723.      ELSE
  724.        (* Kreise malen *)
  725.        Circle (x+2, y+2, Max (CharWidth*2-4,1), Max (CharHeight-4, 1), 1, FALSE);
  726.        IF sel
  727.        THEN
  728.          (* Fllen *)
  729.          Circle (x+5, y+5, Max (CharWidth*2 - 10, 1), Max (CharHeight - 10, 1), 1, TRUE);
  730.        END;
  731.      END;
  732.    ELSE
  733.      (* Checkboxen: Rechteck, ggf. gefllt oder Linien durch *)
  734.      Frame (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1);
  735.      IF check & sel
  736.      THEN
  737.        (* mit Punkten fllen *)
  738.        h:= MagicVDI.SetFillcolor (PrivateWS, 1); (* Fllfarbe schwarz *)
  739.        h:= MagicVDI.SetFillinterior (PrivateWS, 2); (* Flltyp ausw„hlen *)
  740.        h:= MagicVDI.SetFillstyle (PrivateWS, 1); (* Fll Style Index setzen *)
  741.        Rect (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight - 4, 1), 1);     (* Fllen *)
  742.        h:= MagicVDI.SetFillcolor (PrivateWS, 0); (* Fllfarbe weiž *)
  743.        h:= MagicVDI.SetFillinterior (PrivateWS, 1); (* Flltyp ausw„hlen *)
  744.        h:= MagicVDI.SetFillstyle (PrivateWS, 0); (* Fll Style Index setzen *)
  745.      ELSIF sel
  746.      THEN
  747.        (* Linien ber Kreuz malen *)
  748.        Line (x+2, y+2, CharWidth*2-4, CharHeight-4);
  749.        Line (x+CharWidth*2-2, y+2, -CharWidth*2+4, CharHeight-4);
  750.      END;
  751.    END; 
  752.  END;
  753. END Image;
  754.  
  755. PROCEDURE Image3D (x, y: sINTEGER; typ: ButtonType; sel: BOOLEAN; check : BOOLEAN);
  756. (* Bringt die Images auf den Bildschirm *)
  757. VAR m: MFDB;
  758.     h: sINTEGER;
  759. BEGIN
  760.  IF ((CharHeight = 16) OR (CharHeight = 8))
  761.    & (typ # other) & (typ # radio)
  762.  THEN
  763.    (* Fertige Images blitten *)
  764.    IF typ = circle THEN
  765.     IF CharHeight < 16 THEN  h:=  7;  m.fdAddr:= fCircle[sel];  
  766.                        ELSE  h:= 15;  m.fdAddr:= mCircle[sel];
  767.     END;
  768.    ELSIF typ = radio THEN
  769.     IF CharHeight < 16 THEN  h:=  7;  m.fdAddr:= fKnopf[sel];
  770.                        ELSE  h:= 15;  m.fdAddr:= mKnopf[sel];
  771.     END;
  772.    ELSE
  773.     IF CharHeight < 16 THEN  h:=  7;  IF check & sel THEN m.fdAddr := fPunktEin ELSE m.fdAddr:= fSelect[sel]; END;
  774.                        ELSE  h:= 15;  IF check & sel THEN m.fdAddr := mPunktEin ELSE m.fdAddr:= mSelect[sel]; END;
  775.     END;
  776.    END;
  777.    m.fdW:= 16;
  778.    m.fdH:= h;
  779.    m.fdWdwidth:= 1;
  780.    m.fdStand:= 0;
  781.    m.fdNplanes:= 1; (* Image hat nur eine Bitplane! *)
  782.    Rect (x, y, 16, h-1, 8); (* Vorl”schen *)
  783.    VDIPtsIn[0]:= 0;
  784.    VDIPtsIn[1]:= 0;
  785.    VDIPtsIn[2]:= 15;
  786.    VDIPtsIn[3]:= h;
  787.    VDIPtsIn[4]:= x;
  788.    VDIPtsIn[5]:= y;
  789.    VDIPtsIn[6]:= x + 15;
  790.    VDIPtsIn[7]:= y + h-1;
  791.    control7^:= ADR(m);
  792.    control9^:= ADR(ScreenMFDB);
  793.    VDIIntIn[0]:= 2;
  794.    VDIIntIn[1]:= 1;
  795.    VDIIntIn[2]:= 8;
  796.    VDICall (121, 4, 3, 0, PrivateWS);  (* RasterTransparent *)
  797.  ELSE
  798.    Rect (x, y, CharWidth*2, CharHeight-1, 8); (* Vorl”schen *)
  799.    IF typ = circle 
  800.    THEN
  801.      (* CircleButton zeichnen: Rechteck und darin Downarrow *)
  802.      Frame (x, y, CharWidth*2, CharHeight-1, 1);
  803.      h:= SetWritemode (PrivateWS, TRANSPARENT);
  804.      Text (PrivateWS, x+CharWidth DIV 2, y+1, 02c+0c);
  805.      IF sel THEN
  806.        h:= SetWritemode (PrivateWS, XOR);
  807.        Rect (x+1, y+1, CharWidth*2 -2, Max (CharHeight - 3, 1), 1);     (* Invert *)
  808.      END;
  809.      h:= SetWritemode (PrivateWS, REPLACE);
  810.    ELSIF typ = radio
  811.    THEN
  812.      (* Radiobutton: Bei Gr”žen < 12 Punkt Rechteck Outlined und Innenfl„che gefllt oder nicht, 
  813.       *              ansonsten Kreise zeichnen 
  814.       *)
  815.      IF (CharHeight < 12)
  816.      THEN
  817.        IF sel
  818.        THEN
  819.          Frame3D (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 9, 0);
  820.          Rect (x+4, y+4, Max (CharWidth*2-8, 1), Max (CharHeight-8, 1), 1);
  821.        ELSE
  822.          Frame3D (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 0, 9);
  823.        END;
  824.      ELSE
  825.        (* Kreise malen *)
  826.        Circle3D (x+2, y+2, Max (CharWidth*2-4,1), Max (CharHeight-4, 1), sel);
  827.      END;
  828.    ELSE
  829.      (* Checkboxen: Rechteck, ggf. gefllt oder Linien durch *)
  830.      IF sel
  831.      THEN
  832.        Frame3D (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 9, 0);
  833.        IF check
  834.        THEN
  835.          (* mit Punkten fllen *)
  836.          h:= SetWritemode (PrivateWS, TRANSPARENT);
  837.          h:= MagicVDI.SetFillcolor (PrivateWS, 1); (* Fllfarbe schwarz *)
  838.          h:= MagicVDI.SetFillinterior (PrivateWS, 2); (* Flltyp ausw„hlen *)
  839.          h:= MagicVDI.SetFillstyle (PrivateWS, 1); (* Fll Style Index setzen *)
  840.          Rect (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight - 4, 1), 1);     (* Fllen *)
  841.          h:= MagicVDI.SetFillcolor (PrivateWS, 0); (* Fllfarbe weiž *)
  842.          h:= MagicVDI.SetFillinterior (PrivateWS, 1); (* Flltyp ausw„hlen *)
  843.          h:= MagicVDI.SetFillstyle (PrivateWS, 0); (* Fll Style Index setzen *)
  844.          h:= SetWritemode (PrivateWS, REPLACE);
  845.  
  846.          (* Innen mit dunkel fllen *)
  847. (*         Rect (x+3, y+3, Max (CharWidth*2-6, 1), Max (CharHeight-6, 1), 9); *)
  848.        ELSE
  849.          (* Linien ber Kreuz malen *)
  850.          Line (x+2, y+2, CharWidth*2-4, CharHeight-4);
  851.          Line (x+2, y+3, CharWidth*2-5, CharHeight-5);
  852.          Line (x+CharWidth*2-2, y+2, -CharWidth*2+4, CharHeight-4);
  853.          Line (x+CharWidth*2-2, y+3, -CharWidth*2+5, CharHeight-5);
  854.        END;
  855.      ELSE
  856.        Frame3D (x+2, y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 0, 9);
  857.      END;
  858.    END; 
  859.  END;
  860. END Image3D;
  861.  
  862. PROCEDURE String (xx, yy, ww: sINTEGER; VAR string: ARRAY OF CHAR;
  863.                   flags: sBITSET; center: BOOLEAN): sINTEGER;
  864. (* Zeichnet einen String, scannt dabei auch nach den '['-Shortcuts.
  865.  * Dadurch werden nur Shortcuts erkannt, die auch gezeichnet wurden!
  866.  *)
  867. VAR pos, i, j: sINTEGER;
  868.     (*$Reg*)  len: sINTEGER;
  869.     (*$Reg*)  c: sINTEGER; 
  870.     eff: sBITSET;
  871.     old: ADDRESS;
  872.     ch:  CHAR;
  873.     bs:  BITSET;
  874.     str: ARRAY [0..255] OF sINTEGER;
  875. BEGIN
  876.  c:= 0;  len:= 0;  pos:= -1;  ch:= 0C;
  877.  IF SELECTED IN flags THEN  
  878.    i:= SetWritemode (PrivateWS, XOR);  
  879.  ELSE
  880.    i:= SetWritemode (PrivateWS, TRANSPARENT);  
  881.  END;
  882.  LOOP
  883.   IF string[c] = 0C THEN  str[len]:= 0;  EXIT;  END;
  884.   IF string[c] = ShortCut THEN
  885.    pos:= c * ChWidth;  INC (c);  ch:= CAP (string[c]);
  886.   END;
  887.   str[len]:= ORD(string[c]);  INC (c);  INC (len);
  888.  END;
  889.  IF center THEN  i:= (ww - (len * ChWidth)) DIV 2;  ELSE  i:= 0;  END;
  890.  eff:= {};
  891.  IF DISABLED IN flags THEN  INCL (eff, Light);  END;
  892.  IF DRAW3D   IN flags THEN  INCL (eff, Fat);  END;
  893.  bs:= SetTexteffect (PrivateWS, eff);
  894.  old:= MagicVDI.VDIPB.intin;
  895.  MagicVDI.VDIPB.intin:= ADR (str);
  896.  VDIPtsIn[0]:= xx + i;
  897.  VDIPtsIn[1]:= yy;
  898.  VDICall(8, 1, len, 0, PrivateWS);
  899.  MagicVDI.VDIPB.intin:= old;
  900.  IF pos >= 0 THEN
  901.   IF DISABLED IN flags
  902.   THEN
  903.     j := MagicVDI.SetLinetype (PrivateWS, MagicVDI.User);
  904.     MagicVDI.SetUserlinestyle (PrivateWS, $5555);
  905.   END;
  906.   Line (xx + i + pos - 1, yy + CharHeight - 1, ChWidth, 0);
  907.   IF DISABLED IN flags
  908.   THEN
  909.     i := MagicVDI.SetLinetype (PrivateWS, MagicVDI.Line);
  910.   END;
  911.  END; (* IF pos *)
  912.  (*
  913.  IF SELECTED IN flags THEN  i:= SetWritemode (PrivateWS, REPLACE);  END;
  914.  *)
  915.  i:= SetWritemode (PrivateWS, REPLACE);
  916.  bs:= SetTexteffect (PrivateWS, {});
  917.  (* Shortcut-Zeichen in Scancode wandeln *)
  918.  CASE ORD (ch) OF
  919.   48..57, 65..90:  RETURN scancodes[ORD(ch)];|
  920.   ELSE  RETURN 0;  (* Illegaler Shortcut!!! *);
  921.  END;
  922. END String;
  923.  
  924. PROCEDURE String3D (xx, yy, ww: sINTEGER; VAR string: ARRAY OF CHAR;
  925.                     flags: sBITSET; center: BOOLEAN; textmove: BOOLEAN): sINTEGER;
  926. (* Zeichnet einen String, scannt dabei auch nach den '['-Shortcuts.
  927.  * Dadurch werden nur Shortcuts erkannt, die auch gezeichnet wurden!
  928.  *)
  929. VAR pos, i, j: sINTEGER;
  930.     (*$Reg*)  len: sINTEGER;
  931.     (*$Reg*)  c: sINTEGER; 
  932.     eff: sBITSET;
  933.     old: ADDRESS;
  934.     ch:  CHAR;
  935.     bs:  BITSET;
  936.     str: ARRAY [0..255] OF sINTEGER;
  937. BEGIN
  938.  c:= 0;  len:= 0;  pos:= -1;  ch:= 0C;
  939.  IF textmove & (SELECTED IN flags) THEN INC (xx); INC (yy); END;
  940.  i := SetWritemode (PrivateWS, TRANSPARENT);
  941.  LOOP
  942.   IF string[c] = 0C THEN  str[len]:= 0;  EXIT;  END;
  943.   IF string[c] = ShortCut THEN
  944.    pos:= c * ChWidth;  INC (c);  ch:= CAP (string[c]);
  945.   END;
  946.   str[len]:= ORD(string[c]);  INC (c);  INC (len);
  947.  END;
  948.  IF center THEN  i:= (ww - (len * ChWidth)) DIV 2;  ELSE  i:= 0;  END;
  949.  eff:= {};
  950.  IF DISABLED IN flags THEN  INCL (eff, Light);  END;
  951.  IF DRAW3D   IN flags THEN  INCL (eff, Fat);  END;
  952.  bs:= SetTexteffect (PrivateWS, eff);
  953.  old:= MagicVDI.VDIPB.intin;
  954.  MagicVDI.VDIPB.intin:= ADR (str);
  955.  VDIPtsIn[0]:= xx + i;
  956.  VDIPtsIn[1]:= yy;
  957.  VDICall(8, 1, len, 0, PrivateWS);
  958.  MagicVDI.VDIPB.intin:= old;
  959.  IF pos >= 0 THEN
  960.   IF DISABLED IN flags
  961.   THEN
  962.     j := MagicVDI.SetLinetype (PrivateWS, MagicVDI.User);
  963.     MagicVDI.SetUserlinestyle (PrivateWS, $5555);
  964.   END;
  965.   Line (xx + i + pos - 1, yy + CharHeight - 1, ChWidth, 0);
  966.   IF DISABLED IN flags
  967.   THEN
  968.     i := MagicVDI.SetLinetype (PrivateWS, MagicVDI.Line);
  969.   END;
  970.  END; (* IF pos *)
  971.  i := SetWritemode (PrivateWS, REPLACE);
  972.  bs:= SetTexteffect (PrivateWS, {});
  973.  (* Shortcut-Zeichen in Scancode wandeln *)
  974.  CASE ORD (ch) OF
  975.   48..57, 65..90:  RETURN scancodes[ORD(ch)];|
  976.   ELSE  RETURN 0;  (* Illegaler Shortcut!!! *);
  977.  END;
  978. END String3D;
  979.  
  980. PROCEDURE Shadow (x, y, w, h, times: sINTEGER);
  981. (* Zeichnet einen Schatten an ein Objekt, times bestimmt die Dicke *)
  982. VAR i: sINTEGER;
  983. BEGIN
  984.  FOR i:= 1 TO times DO
  985.   INC (w);  INC (h);
  986.   VDIPtsIn[0]:= x;
  987.   VDIPtsIn[1]:= y + h;
  988.   VDIPtsIn[2]:= x + w;
  989.   VDIPtsIn[3]:= VDIPtsIn[1]; (* y + h; *)
  990.   VDIPtsIn[4]:= VDIPtsIn[2]; (* x + w; *)
  991.   VDIPtsIn[5]:= y;
  992.   VDICall(6, 3, 0, 0, PrivateWS);
  993.  END;
  994. END Shadow;
  995.  
  996. (*-----------------------------------------------------------------------*)
  997. (*
  998. PROCEDURE DrawBox (p: PtrPARMBLK): sBITSET;
  999. (* Zeichnet eine BOX, IBOX oder BOXCHAR *)
  1000. VAR i: sINTEGER;
  1001.     t: tObjcTree;
  1002.     d: DIALOG;
  1003. BEGIN
  1004.  t:= p^.pbTree;  d:= mtXobjects.GetPrivate (p^.pbTree, p^.pbObj);
  1005.  selected:= SELECTED IN p^.prCurrstate;
  1006.  WITH t^[p^.pbObj] DO
  1007.    
  1008.  END;
  1009. END DrawBox;
  1010. *)
  1011.  
  1012. PROCEDURE DrawMover (p: PtrPARMBLK): sBITSET;
  1013. (* zeichnet die Movebox *)
  1014. VAR i: sINTEGER;
  1015.     t: tObjcTree;
  1016.     d: DIALOG;
  1017. BEGIN
  1018.  t:= p^.pbTree;  d:= mtXobjects.GetPrivate (p^.pbTree, p^.pbObj);
  1019.  WITH t^[p^.pbObj] DO
  1020.   DEC (p^.pbX);  i:= 4;
  1021.   Rect (p^.pbX - 2, p^.pbY - 2, 2, p^.pbH, 0);
  1022.   Rect (p^.pbX - 2, p^.pbY + p^.pbH, p^.pbW + 2, 2, 0);
  1023.   VDIPtsIn[ 0]:= p^.pbX - 3;
  1024.   VDIPtsIn[ 1]:= p^.pbY - 3;
  1025.   VDIPtsIn[ 2]:= p^.pbX + p^.pbW + 3;
  1026.   VDIPtsIn[ 3]:= p^.pbY + p^.pbH + 3;
  1027.   VDIPtsIn[ 4]:= VDIPtsIn[0];
  1028.   VDIPtsIn[ 5]:= VDIPtsIn[3];
  1029.   VDIPtsIn[ 6]:= VDIPtsIn[0];
  1030.   VDIPtsIn[ 7]:= VDIPtsIn[1];
  1031. (*  IF cMove IN d^.flags THEN *)
  1032.    i:= 7;
  1033.    VDIPtsIn[ 8]:= p^.pbX;
  1034.    VDIPtsIn[ 9]:= p^.pbY;
  1035.    VDIPtsIn[10]:= p^.pbX;
  1036.    VDIPtsIn[11]:= p^.pbY + p^.pbH;
  1037.    VDIPtsIn[12]:= p^.pbX + p^.pbW;
  1038.    VDIPtsIn[13]:= VDIPtsIn[11];
  1039. (*  END; *)
  1040.   VDICall(6, i, 0, 0, PrivateWS);
  1041.  END;
  1042.  RETURN {};
  1043. END DrawMover;
  1044.  
  1045. PROCEDURE DrawButton (p: PtrPARMBLK): sBITSET;
  1046. (* Zeichnet einen Knopf, eine Crossbox oder einen Button *)
  1047. VAR thick, off, roff, col, ch, bh, i, j: sINTEGER;
  1048.     selected, center: BOOLEAN;
  1049.     t:   tObjcTree;
  1050.     obspec: Objcspec;
  1051.     butt: ButtonType;
  1052.     r   : tRect;
  1053. BEGIN
  1054.  t:= p^.pbTree;  obspec.address:= p^.pbParm;
  1055.  selected:= SELECTED IN p^.prCurrstate;
  1056.  WITH t^[p^.pbObj] DO
  1057.   IF (cCoords IN t^[p^.pbObj].obFlags)
  1058.   THEN
  1059.     WITH r DO
  1060.       x := p^.pbX + 4;
  1061.       y := p^.pbY + 4;
  1062.       w := p^.pbW - 8;
  1063.       h := p^.pbH - 8;
  1064.     END;
  1065.   ELSE
  1066.     WITH r DO
  1067.       x := p^.pbX;
  1068.       y := p^.pbY;
  1069.       w := p^.pbW;
  1070.       h := p^.pbH;
  1071.     END;
  1072.   END;
  1073.   IF (RBUTTON IN obFlags) OR NOT (Exit IN obFlags) THEN
  1074.    (* Knopf bzw. Crossbox zeichnen *)
  1075.    (* Rect (p^.pbX, p^.pbY, p^.pbW, p^.pbH-1 , 0); (* Vorl”schen *) *)
  1076.    Rect (r.x, r.y, r.w, r.h-1 , 0); (* Vorl”schen *)
  1077.    IF RBUTTON IN obFlags THEN butt:= radio ELSE butt:= other END;
  1078.    (* Image (p^.pbX, p^.pbY, butt, selected, FALSE); *)
  1079.    Image (r.x, r.y, butt, selected, FALSE);
  1080.    roff:= ROffset;  center:= FALSE;
  1081.   ELSIF (Exit IN obFlags) THEN (* "richtiger" Button *)
  1082.    IF selected THEN  col:= 1;  ELSE  col:= 0;  END;
  1083.    (* Rect (p^.pbX, p^.pbY, p^.pbW, p^.pbH, col); (* Vorl”schen *) *)
  1084.    Rect (r.x, r.y, r.w, r.h , col); (* Vorl”schen *)
  1085.    roff:= 0;  center:= TRUE;
  1086.    IF DEFAULT IN obFlags THEN  thick:= 3;
  1087.    ELSIF Exit IN obFlags THEN  thick:= 2;  
  1088.                          ELSE  thick:= 1;
  1089.    END;
  1090.    (* Frame (p^.pbX, p^.pbY, p^.pbW, p^.pbH, thick); *)
  1091.    Frame (r.x, r.y, r.w, r.h, thick);
  1092.    IF SHADOWED IN obState THEN
  1093.     (* Shadow (p^.pbX, p^.pbY, p^.pbW, p^.pbH, thick * 2); *)
  1094.     Shadow (r.x, r.y, r.w, r.h, thick * 2);
  1095.    END;
  1096.   END;
  1097.   (* IF obHeight > CharHeight THEN  off:= (obHeight - CharHeight) DIV 2; *)
  1098.   IF r.h > CharHeight THEN  off:= (r.h - CharHeight) DIV 2;
  1099.                       ELSE  off:= 0;
  1100.   END;
  1101.   IF CHECKED  IN p^.prCurrstate THEN
  1102.    j:= MagicVDI.SetCharpoints (PrivateWS, 1, ChWidth, i, i, bh);
  1103.    (*  off:= (obHeight DIV 2) - 2;  center:= TRUE; *)
  1104.    off:= (r.h DIV 2) - 2;  center:= TRUE;
  1105.   END;
  1106.  (* ch:= String (p^.pbX + roff, p^.pbY + off, p^.pbW,  *)
  1107.    ch:= String (r.x + roff, r.y + off, r.w, 
  1108.                obspec.StringPtr^, p^.prCurrstate, center);
  1109.   SetUserkey (t, p^.pbObj, ch, ShortKey, TRUE, TRUE);
  1110.   IF CHECKED  IN p^.prCurrstate THEN
  1111.    SetCharheight (PrivateWS, ChSize, i, i, i, i);
  1112.    ChWidth:= CharWidth;
  1113.   END;
  1114.  END;
  1115.  RETURN {};
  1116. END DrawButton;
  1117.  
  1118. PROCEDURE Draw3DButton (p: PtrPARMBLK): sBITSET;
  1119. (* Zeichnet einen Knopf, eine Crossbox oder einen Button *)
  1120. VAR thick, off, roff, col, ch, bh, i, j: sINTEGER;
  1121.     selected, center: BOOLEAN;
  1122.     t:   tObjcTree;
  1123.     obspec: Objcspec;
  1124.     butt: ButtonType;
  1125.     r   : tRect;
  1126.     realButt : BOOLEAN;
  1127. BEGIN
  1128.  t:= p^.pbTree;  obspec.address:= p^.pbParm;
  1129.  selected:= SELECTED IN p^.prCurrstate;
  1130.  realButt := FALSE;
  1131.  WITH t^[p^.pbObj] DO
  1132.   IF (cCoords IN t^[p^.pbObj].obFlags)
  1133.   THEN
  1134.     WITH r DO
  1135.       x := p^.pbX + 4;
  1136.       y := p^.pbY + 4;
  1137.       w := p^.pbW - 8;
  1138.       h := p^.pbH - 8;
  1139.     END;
  1140.   ELSE
  1141.     WITH r DO
  1142.       x := p^.pbX;
  1143.       y := p^.pbY;
  1144.       w := p^.pbW;
  1145.       h := p^.pbH;
  1146.     END;
  1147.   END;
  1148.   IF (RBUTTON IN obFlags) OR NOT (Exit IN obFlags) THEN
  1149.    (* Knopf bzw. Crossbox zeichnen *)
  1150.    (* Rect (p^.pbX, p^.pbY, p^.pbW, p^.pbH-1 , 0); (* Vorl”schen *) *)
  1151.    Rect (r.x, r.y, r.w, r.h-1 , 8); (* Vorl”schen *)
  1152.    IF RBUTTON IN obFlags THEN butt:= radio ELSE butt:= other END;
  1153.    (* Image (p^.pbX, p^.pbY, butt, selected, FALSE); *)
  1154.    Image3D (r.x, r.y, butt, selected, FALSE);
  1155.    (*
  1156.    IF butt = radio
  1157.    THEN
  1158.      Image3D (r.x, r.y, butt, selected, FALSE);
  1159.    ELSE
  1160.      (* Checkboxen: Rechteck, ggf. gefllt oder Linien durch *)
  1161.      IF selected
  1162.      THEN
  1163.        Frame3D (r.x+2, r.y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 9, 0);
  1164.        (* Linien ber Kreuz malen *)
  1165.        Line (r.x+2, r.y+2, CharWidth*2-4, CharHeight-4);
  1166.        Line (r.x+2, r.y+3, CharWidth*2-5, CharHeight-5);
  1167.        Line (r.x+CharWidth*2-2, r.y+2, -CharWidth*2+4, CharHeight-4);
  1168.        Line (r.x+CharWidth*2-2, r.y+3, -CharWidth*2+5, CharHeight-5);
  1169.      ELSE
  1170.        Frame3D (r.x+2, r.y+2, Max (CharWidth*2-4, 1), Max (CharHeight-4, 1), 1, 0, 9);
  1171.      END;
  1172.    END;
  1173.    *)
  1174.    roff:= ROffset;  center:= FALSE;
  1175.   ELSIF (Exit IN obFlags) THEN (* "richtiger" Button *)
  1176.    realButt := TRUE;
  1177.    col := 8;
  1178.    (* Rect (p^.pbX, p^.pbY, p^.pbW, p^.pbH, col); (* Vorl”schen *) *)
  1179.    Rect (r.x, r.y, r.w, r.h , col); (* Vorl”schen *)
  1180.    roff:= 0;  center:= TRUE;
  1181.    IF DEFAULT IN obFlags THEN  thick:= 2;
  1182.                          ELSE  thick:= 1;
  1183.    END;
  1184.    (* 3D-Rahmen zeichnen *)
  1185.    IF selected
  1186.    THEN
  1187.      Frame3D (r.x, r.y, r.w, r.h, thick, 9, 0);
  1188.    ELSE
  1189.      Frame3D (r.x, r.y, r.w, r.h, thick, 0, 9);
  1190.    END;
  1191.    (* Dnnen schwarzen Rand zeichnen *)
  1192.    Frame (r.x-thick, r.y-thick, r.w+thick*2, r.h+thick*2, 1);
  1193.    IF SHADOWED IN obState THEN
  1194.     (* Shadow (p^.pbX, p^.pbY, p^.pbW, p^.pbH, thick * 2); *)
  1195.     Shadow (r.x, r.y, r.w, r.h, thick * 2);
  1196.    END;
  1197.   END;
  1198.   (* IF obHeight > CharHeight THEN  off:= (obHeight - CharHeight) DIV 2; *)
  1199.   IF r.h > CharHeight THEN  off:= (r.h - CharHeight) DIV 2;
  1200.                       ELSE  off:= 0;
  1201.   END;
  1202.   IF CHECKED  IN p^.prCurrstate THEN
  1203.    j:= MagicVDI.SetCharpoints (PrivateWS, 1, ChWidth, i, i, bh);
  1204.    (*  off:= (obHeight DIV 2) - 2;  center:= TRUE; *)
  1205.    off:= (r.h DIV 2) - 2;  center:= TRUE;
  1206.   END;
  1207.  (* ch:= String (p^.pbX + roff, p^.pbY + off, p^.pbW,  *)
  1208.    ch:= String3D (r.x + roff, r.y + off, r.w, 
  1209.                obspec.StringPtr^, p^.prCurrstate, center, realButt);
  1210.   SetUserkey (t, p^.pbObj, ch, ShortKey, TRUE, TRUE);
  1211.   IF CHECKED  IN p^.prCurrstate THEN
  1212.    SetCharheight (PrivateWS, ChSize, i, i, i, i);
  1213.    ChWidth:= CharWidth;
  1214.   END;
  1215.  END;
  1216.  RETURN {};
  1217. END Draw3DButton;
  1218.  
  1219. PROCEDURE DrawText (p: PtrPARMBLK): sBITSET;
  1220. TYPE Typeset =    SET OF [GBOX..GTITLE];
  1221. VAR i, l, col, bh, ch: sINTEGER;
  1222.     eff: sBITSET;
  1223.     t:   tObjcTree;
  1224.     obspec: Objcspec;
  1225.     strPtr: MagicAES.PtrSTRING;
  1226.  
  1227.  PROCEDURE Write (x, y, col: sINTEGER; REF str: ARRAY OF CHAR); 
  1228.  BEGIN
  1229.   i:= SetTextcolor (PrivateWS, col);
  1230.   Text (PrivateWS, x, y, str);
  1231.  END Write;
  1232.  
  1233. BEGIN
  1234.  t:= p^.pbTree;  obspec.address:= p^.pbParm;  eff:= {};
  1235.  WITH t^[p^.pbObj] DO
  1236.   (* Objecttyp holen *)
  1237.   i := GetLowbyte(mtXobjects.GetObtype (t, p^.pbObj));
  1238.   IF i IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN 
  1239.     strPtr := MagicAES.PtrSTRING(obspec.TedPtr^.tePtext)
  1240.   ELSIF i = GSTRING
  1241.   THEN
  1242.     strPtr := obspec.StringPtr
  1243.   ELSE
  1244.     RETURN {};
  1245.   END;
  1246.   IF (SELECTED IN p^.prCurrstate) AND NOT (WHITEBAK IN p^.prCurrstate) THEN
  1247.    col:= 1  ELSE  col:= 0  
  1248.   END;
  1249.   IF CHECKED  IN obState THEN
  1250.    i:= MagicVDI.SetCharpoints (PrivateWS, 1, ChWidth, i, i, bh);
  1251.   ELSE
  1252.    bh:= obHeight;
  1253.   END;
  1254.   (*
  1255.   IF mode3D 
  1256.   THEN
  1257.     col := 8;
  1258.   END;
  1259.   Rect (p^.pbX, p^.pbY, p^.pbW-1, bh-1, col);
  1260.   *)
  1261.   IF WHITEBAK IN p^.prCurrstate THEN (* Zeichnet Shadowtext *)
  1262.    i:= SetWritemode (PrivateWS, TRANSPARENT);
  1263.    Write (p^.pbX + 2, p^.pbY + 2, 1, strPtr^);
  1264.    Write (p^.pbX + 1, p^.pbY + 1, 0, strPtr^);
  1265.    Write (p^.pbX, p^.pbY, 1, strPtr^);
  1266.    (*
  1267.    Write (p^.pbX + 2, p^.pbY + 2, 1, obspec.StringPtr^);
  1268.    Write (p^.pbX + 1, p^.pbY + 1, 0, obspec.StringPtr^);
  1269.    Write (p^.pbX, p^.pbY, 1, obspec.StringPtr^);
  1270.    *)
  1271.    i:= SetWritemode (PrivateWS, REPLACE);
  1272.   ELSE
  1273.   (*
  1274.    ch:= String (p^.pbX, p^.pbY, p^.pbW, obspec.StringPtr^,
  1275.    *)
  1276.    ch:= String (p^.pbX, p^.pbY, p^.pbW, strPtr^,
  1277.                 p^.prCurrstate, FALSE);
  1278.    IF (SELECTABLE IN obFlags) OR (TOUCHEXIT IN obFlags) THEN
  1279.     (* Anw„hlbar, also auch Shortcut eintragen! *)
  1280.     SetUserkey (t, p^.pbObj, ch, ShortKey, TRUE, TRUE);
  1281.    END; 
  1282.    IF (SHADOWED IN p^.prCurrstate) OR (OUTLINED IN p^.prCurrstate) THEN
  1283.     (*
  1284.     ObjcStrLen (t, p^.pbObj, l, i);
  1285.     l:= l * ChWidth;  l:= Max (l, obWidth);
  1286.     l := LENGTH (obspec.StringPtr^);
  1287.     WHILE (l > 0) & (obspec.StringPtr^[l-1]=' ') DO DEC (l) END;
  1288.     *)
  1289.     l := LENGTH (strPtr^);
  1290.     WHILE (l > 0) & (strPtr^[l-1]=' ') DO DEC (l) END;
  1291.     l := l * ChWidth;
  1292.     Line (p^.pbX, p^.pbY + bh, l, 0);
  1293.     IF OUTLINED IN p^.prCurrstate THEN
  1294.      Line (p^.pbX, p^.pbY + bh + 2, l, 0);
  1295.     END;
  1296.    END;
  1297.    SetCharheight (PrivateWS, ChSize, i, i, i, i);
  1298.    eff:= SetTexteffect (PrivateWS, {});
  1299.    ChWidth:= CharWidth;
  1300.   END;
  1301.  END;
  1302.  RETURN {};
  1303. END DrawText;
  1304.  
  1305. (* Eine Zeichenfunktion, um ein Textobject zu zeichnen 
  1306.  *)
  1307. PROCEDURE BuildStr (REF text, tmplt : ARRAY OF CHAR; offs, maxLen: sINTEGER; 
  1308.                     VAR str: ARRAY OF CHAR);
  1309.   VAR i, j, k : sINTEGER;
  1310. BEGIN
  1311.   i := 0;
  1312.   WHILE (i < maxLen) & (tmplt[i] # '_') & (tmplt[i] # '') DO
  1313.     str[i] := tmplt[i];
  1314.     INC (i);
  1315.   END;
  1316.   k := i;
  1317.   (* Zeichen bis offs in text berspringen *)
  1318.   j := 0;
  1319.   WHILE (text[j] # '') & (j < offs) DO
  1320.     INC (j);
  1321.   END;
  1322.   WHILE (i < maxLen) DO
  1323.     IF text[j] = ''
  1324.     THEN
  1325.       (* tmplt kopieren *)
  1326.       str[i] := tmplt [i+k];
  1327.     ELSE
  1328.       str[i] := text[j];
  1329.       INC (j);
  1330.     END;
  1331.     INC (i);
  1332.   END;
  1333.   IF text[j] # ''
  1334.   THEN
  1335.     str[i] := CHR(3);
  1336.     INC (i);
  1337.   ELSE
  1338.     str[i] := ' ';
  1339.     INC (i);
  1340.   END;
  1341.   str[i] := '';
  1342. END BuildStr;
  1343.  
  1344. PROCEDURE DrawEdText (p: PtrPARMBLK): sBITSET;
  1345. TYPE Typeset =    SET OF [GBOX..GTITLE];
  1346. VAR i, l, col, bh, ch: sINTEGER;
  1347.     eff: sBITSET;
  1348.     t:   tObjcTree;
  1349.     obspec: Objcspec;
  1350.     textPtr: MagicAES.PtrTEDINFO;
  1351.     offset : sINTEGER;
  1352.     x, y, w, h:   INTEGER;
  1353.     maxLen: INTEGER;
  1354.     obW   : INTEGER;
  1355.  
  1356. BEGIN
  1357.  t:= p^.pbTree;  obspec.address:= p^.pbParm;  eff:= {};
  1358.  WITH t^[p^.pbObj] DO
  1359.   obW := obWidth;
  1360.   IF (cCoords IN t^[p^.pbObj].obFlags)
  1361.   THEN
  1362.     DEC (obW, ChWidth);
  1363.   END;
  1364.   (* Objecttyp holen *)
  1365.   i := GetLowbyte(mtXobjects.GetObtype (t, p^.pbObj));
  1366.   IF i IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN 
  1367.     textPtr := MagicAES.PtrTEDINFO (obspec.address);
  1368.   ELSE
  1369.     RETURN {};
  1370.   END;
  1371.   IF (SELECTED IN p^.prCurrstate) AND NOT (WHITEBAK IN p^.prCurrstate) THEN
  1372.    col:= 1  ELSE  col:= 0  
  1373.   END;
  1374.   (*
  1375.   Rect (p^.pbX, p^.pbY, p^.pbW-1 + ChWidth, obHeight-1, col);
  1376.   *)
  1377.   IF textPtr^.teFont = MagicAES.SMALL
  1378.   THEN
  1379.     i := MagicVDI.SetCharpoints (PrivateWS, 1, w, i, i, h);
  1380.   ELSE
  1381.     w := ChWidth;
  1382.     h := CharHeight;
  1383.   END;
  1384.   Rect (p^.pbX + obW-1, p^.pbY, ChWidth, obHeight-1, col);
  1385.   maxLen := Min (obW DIV ChWidth, LENGTH (textPtr^.tePtmplt^));
  1386.   BuildStr (textPtr^.tePtext^, textPtr^.tePtmplt^, textPtr^.teFontid, maxLen, theText);
  1387.   y := p^.pbY;
  1388.   INC (y, (p^.pbH - CharHeight) DIV 2);
  1389.   x := p^.pbX;
  1390.   Text (PrivateWS, x, y, theText);
  1391.  
  1392.   SetCharheight (PrivateWS, ChSize, i, i, i, i);
  1393.  
  1394.   (*
  1395.   ch:= String (p^.pbX, p^.pbY, p^.pbW, theText,
  1396.                p^.prCurrstate, FALSE);
  1397.   *)
  1398.   RETURN {};
  1399.  END;
  1400. END DrawEdText;
  1401.  
  1402. PROCEDURE DrawFrame (p: PtrPARMBLK): sBITSET;
  1403. VAR eff: sBITSET;
  1404.     i, j, size, off, off2, col: sINTEGER;
  1405.     minA, maxA, maxW, ch, cw: sINTEGER;
  1406.     c: CARDINAL;
  1407.     t:   tObjcTree;
  1408.     obspec: Objcspec;
  1409.  
  1410.  PROCEDURE Center (cw: sINTEGER): sINTEGER;
  1411.  BEGIN
  1412.   IF CROSSED IN p^.prCurrstate THEN
  1413.    c:= Length (obspec.StringPtr^);  j:= CastToInt (c);
  1414.    i:= p^.pbX + (p^.pbW - (j * cw)) DIV 2;
  1415.   ELSE
  1416.    i:= p^.pbX + (cw DIV 2);
  1417.   END;
  1418.   RETURN i;
  1419.  END Center;
  1420.  
  1421. BEGIN
  1422.  t:= p^.pbTree;  obspec.address:= p^.pbParm;  eff:= {};
  1423.  WITH t^[p^.pbObj] DO
  1424.   IF SELECTED IN obState THEN  col:= 1  ELSE  col:= 0  END;
  1425.   Rect (p^.pbX, p^.pbY, p^.pbW, p^.pbH, col);
  1426.   Frame (p^.pbX, p^.pbY, p^.pbW, p^.pbH, 1);
  1427.   IF SHADOWED IN obState THEN
  1428.    Shadow (p^.pbX, p^.pbY, p^.pbW, p^.pbH, 3);
  1429.   END;
  1430.   IF OUTLINED IN obState THEN
  1431.    Frame (p^.pbX + 2, p^.pbY + 2, p^.pbW - 4, p^.pbH - 4, 1);
  1432.   END;
  1433.   IF SELECTED IN obState THEN  i:= SetWritemode (PrivateWS, XOR);  END;
  1434.   IF DISABLED IN obState THEN  INCL (eff, Light);  END;
  1435.   IF DRAW3D   IN obState THEN  INCL (eff, Fat);  END;
  1436.   eff:= SetTexteffect (PrivateWS, eff);
  1437.   IF CHECKED  IN obState THEN  
  1438.    j:= MagicVDI.SetCharpoints (PrivateWS, 1, j, j, j, j);
  1439.    off:= Center (6);  off2:= 3;
  1440.   ELSE
  1441.    off:= Center (ChWidth);  off2:= 0;
  1442.   END;
  1443.   Text (PrivateWS, off, p^.pbY - (CharHeight DIV 2) + off2, obspec.StringPtr^);
  1444.   SetCharheight (PrivateWS, ChSize, j, j, j, j);
  1445.   i:= SetWritemode (PrivateWS, REPLACE);
  1446.  END;
  1447.  RETURN {};
  1448. END DrawFrame;
  1449.  
  1450. PROCEDURE Draw3DFrame (p: PtrPARMBLK): sBITSET;
  1451. VAR eff: sBITSET;
  1452.     i, j, size, off, off2, col: sINTEGER;
  1453.     minA, maxA, maxW, ch, cw: sINTEGER;
  1454.     c: CARDINAL;
  1455.     t:   tObjcTree;
  1456.     obspec: Objcspec;
  1457.     width : INTEGER;
  1458.  
  1459.  PROCEDURE Center (cw: sINTEGER): sINTEGER;
  1460.  BEGIN
  1461.   c:= Length (obspec.StringPtr^);
  1462.   IF CHECKED IN p^.prCurrstate
  1463.   THEN
  1464.     width := Length (obspec.StringPtr^) * 6;
  1465.   ELSE
  1466.     width := Length (obspec.StringPtr^) * 8;
  1467.   END;
  1468.   IF CROSSED IN p^.prCurrstate THEN
  1469.    j:= CastToInt (c);
  1470.    i:= p^.pbX + (p^.pbW - (j * cw)) DIV 2;
  1471.   ELSE
  1472.    i:= p^.pbX + (cw DIV 2);
  1473.   END;
  1474.   RETURN i;
  1475.  END Center;
  1476.  
  1477. BEGIN
  1478.  t:= p^.pbTree;  obspec.address:= p^.pbParm;  eff:= {};
  1479.  WITH t^[p^.pbObj] DO
  1480.   IF SELECTED IN obState THEN  
  1481.     Frame3D (p^.pbX, p^.pbY, p^.pbW, p^.pbH, 1, 9, 0);
  1482.   ELSE  
  1483.     Frame3D (p^.pbX, p^.pbY, p^.pbW, p^.pbH, 1, 0, 9);
  1484.   END;
  1485.   
  1486.   IF DISABLED IN obState THEN  INCL (eff, Light);  END;
  1487.   IF DRAW3D   IN obState THEN  INCL (eff, Fat);  END;
  1488.   eff:= SetTexteffect (PrivateWS, eff);
  1489.   IF CHECKED  IN obState THEN  
  1490.    j:= MagicVDI.SetCharpoints (PrivateWS, 1, j, j, j, j);
  1491.    off:= Center (6);  off2:= 3;
  1492.   ELSE
  1493.    off:= Center (ChWidth);  off2:= 0;
  1494.   END;
  1495.   Rect (off, p^.pbY - (CharHeight DIV 2) + off2, width, (CharHeight DIV 2), 8);
  1496.   i:= SetWritemode (PrivateWS, TRANSPARENT);
  1497.   Text (PrivateWS, off, p^.pbY - (CharHeight DIV 2) + off2, obspec.StringPtr^);
  1498.   SetCharheight (PrivateWS, ChSize, j, j, j, j);
  1499.   i:= SetWritemode (PrivateWS, REPLACE);
  1500.  END;
  1501.  RETURN {};
  1502. END Draw3DFrame;
  1503.  
  1504. PROCEDURE DrawCircle (p: PtrPARMBLK): sBITSET;
  1505. VAR ex, ob: sINTEGER;
  1506.     t:   tObjcTree;
  1507.     obspec: Objcspec;
  1508.     ret   : sBITSET;
  1509. BEGIN
  1510.  t:= p^.pbTree;  obspec.address:= p^.pbParm;
  1511.  GetObjcExtype (t, p^.pbObj, ex, ob);
  1512.  ret := {};
  1513.  IF ob = GBOXCHAR THEN
  1514.   Image (p^.pbX + 1, p^.pbY, circle, SELECTED IN p^.prCurrstate, FALSE);
  1515.   Frame (p^.pbX + 1, p^.pbY, p^.pbW - 1, p^.pbH - 1, 1); (* GRUMBLE!!! *)
  1516.   IF DISABLED IN p^.prCurrstate
  1517.   THEN
  1518.     INCL (ret, DISABLED);
  1519.   END;
  1520.   (*
  1521.   IF SELECTED IN p^.prCurrstate
  1522.   THEN
  1523.     INCL (ret, SELECTED);
  1524.   END;
  1525.   *)
  1526.  END;
  1527.  RETURN ret;
  1528. END DrawCircle;
  1529.  
  1530. PROCEDURE DrawThreeState (p : PtrPARMBLK): sBITSET;
  1531. (* objc : tObjcTree; entry : sINTEGER); *)
  1532. (* Zeichnet Tree-State-Button:
  1533.  * ~selected & ~checked: Leere Box
  1534.  * selected  & ~checked: angekreuzte Box
  1535.  * selected  &  checked: gepunktete Box
  1536.  *)
  1537.  PROCEDURE swapFlag (VAR set: sBITSET; bit: sCARDINAL);
  1538.  BEGIN
  1539.   IF bit IN set THEN  EXCL (set, bit);  ELSE  INCL (set, bit); END;
  1540.  END swapFlag;
  1541.  
  1542. VAR x, y, thick, off, col, ch: sINTEGER;
  1543.     t   : tObjcTree;
  1544.     obspec: Objcspec;
  1545. BEGIN
  1546.  t := p^.pbTree;  obspec.address:= p^.pbParm;
  1547.  WITH p^ DO
  1548.   IF pbH > CharHeight THEN  off:= (pbH - CharHeight) DIV 2;
  1549.                       ELSE  off:= 0;
  1550.   END;
  1551.   IF mode3D 
  1552.   THEN
  1553.     Rect (pbX, pbY, pbW + ROffset, pbH-1, 8);
  1554.     ch:= String3D (pbX + ROffset, pbY + off, pbW, obspec.StringPtr^, {}, FALSE, FALSE);
  1555.   ELSE
  1556.     Rect (pbX, pbY, pbW + ROffset, pbH-1, 0);
  1557.     ch:= String (pbX + ROffset, pbY + off, pbW, obspec.StringPtr^, {}, FALSE);
  1558.   END;
  1559.   SetUserkey (t, p^.pbObj, ch, ShortKey, TRUE, TRUE);
  1560.   IF prCurrstate # prPrevstate
  1561.   THEN
  1562.     (* Objekt wurde selektiert *)
  1563.     IF (SELECTED IN prPrevstate) & (CHECKED IN prPrevstate)
  1564.     THEN
  1565.      swapFlag (prPrevstate, CHECKED);
  1566.      (* Danach nur noch selected *)
  1567.     ELSIF (SELECTED IN prPrevstate) & ~(CHECKED IN prPrevstate)
  1568.     THEN
  1569.      swapFlag (prPrevstate, SELECTED);
  1570.      (* Danach weder SELECTED noch CHECKED *)
  1571.     ELSIF ~(SELECTED IN prPrevstate)
  1572.     THEN
  1573.      swapFlag (prPrevstate, SELECTED);
  1574.      IF ~(CHECKED IN prPrevstate)
  1575.      THEN
  1576.       (* ~selected & checked darf nicht sein! *)
  1577.       swapFlag (prPrevstate, CHECKED);
  1578.      END;
  1579.      (* Hiernach SELECTED und CHECKED *)
  1580.     END; 
  1581.     prCurrstate := prPrevstate;
  1582.     t^[pbObj].obState := prCurrstate;
  1583.   END;
  1584.   IF CHECKED  IN prCurrstate 
  1585.   THEN
  1586.     (* angekreuzten Button zeichnen *)
  1587.     IF mode3D 
  1588.     THEN
  1589.       Image3D (pbX, pbY, other, TRUE, FALSE);
  1590.     ELSE
  1591.       Image (pbX, pbY, other, TRUE, FALSE);
  1592.     END;
  1593.   ELSE 
  1594.     IF mode3D 
  1595.     THEN
  1596.       Image3D (pbX, pbY, other, ~(SELECTED IN prCurrstate), TRUE);
  1597.     ELSE
  1598.       Image (pbX, pbY, other, ~(SELECTED IN prCurrstate), TRUE);
  1599.     END;
  1600.   END;
  1601.  END;
  1602.  RETURN {}
  1603. END DrawThreeState;
  1604.  
  1605.  
  1606. (*----------------------------------------------------------------------*
  1607.  * Folgende Prozeduren manipulieren in der Dialogliste                  *
  1608.  *----------------------------------------------------------------------*)
  1609.  
  1610. PROCEDURE NewDial (tree: ADDRESS): BOOLEAN;
  1611. VAR q: DIALOG;
  1612.     (*$Reg*)  i: sINTEGER;
  1613.     dial: DIALOG;
  1614.     tr  : tObjcTree;
  1615.     ex, typ: sINTEGER;
  1616.     b: BOOLEAN;
  1617. BEGIN
  1618.  q:= GetDIALOG (tree);
  1619.  IF q = NIL THEN (* Nur Neueintr„ge vornehmen *)
  1620.   ALLOCATE (dial,   TSIZE(Dialog));  
  1621.   IF dial = NIL THEN  RETURN FALSE;  END;
  1622.   IF NOT NewAREA (dial^.back) THEN
  1623.    DEALLOCATE (dial, 0);    RETURN FALSE;
  1624.   END;
  1625.   IF NOT NewAREA (dial^.front) THEN
  1626.    DisposeAREA (dial^.back);  DEALLOCATE (dial, 0);    RETURN FALSE;
  1627.   END;
  1628.   dial^.tree:= tree;
  1629.   dial^.flags:= {};
  1630.   dial^.next:= NIL;
  1631.   dial^.pmode:= -1;
  1632.   IF Dials = NIL THEN (* Erster Dialog *)
  1633.    Dials:= dial;
  1634.   ELSE (* Gibbet schon Dialoge *)
  1635.    q:= Dials;
  1636.    WHILE q^.next # NIL DO  q:= q^.next;  END;
  1637.    q^.next:= dial;
  1638.   END;
  1639.   ResetUserkeys (tree);
  1640.   i:= 0;
  1641.   (* Baum scannen und Extended Objects installieren *)
  1642.   tr := tree;
  1643.   LOOP
  1644.    GetObjcExtype (dial^.tree, i, ex, typ);
  1645.    IF (ex = MoveBox) AND (typ = GIBOX) THEN
  1646.     b:= mtXobjects.InstUserdef (tree, i, DrawMover, dial);
  1647.    ELSIF ex = SpecButton THEN
  1648.     IF mode3D
  1649.     THEN
  1650.       b:= mtXobjects.InstUserdef (tree, i, Draw3DButton, dial);
  1651.     ELSE
  1652.       b:= mtXobjects.InstUserdef (tree, i, DrawButton, dial);
  1653.     END;
  1654.     (* Objektkoordinaten anpassen *)
  1655.     IF ~(cCoords IN tr^[i].obFlags)
  1656.     THEN
  1657.       WITH tr^[i] DO
  1658.         DEC (obX, 4); DEC(obY, 4);
  1659.         INC (obWidth, 8); INC (obHeight, 8);
  1660.         INCL (obFlags, cCoords);
  1661.       END;
  1662.     END;
  1663.    ELSIF ex = SpecText THEN
  1664.     b:= mtXobjects.InstUserdef (tree, i, DrawText, dial);
  1665.    ELSIF ex = FrameBox THEN
  1666.     IF mode3D
  1667.     THEN
  1668.       b:= mtXobjects.InstUserdef (tree, i, Draw3DFrame, dial);
  1669.     ELSE
  1670.       b:= mtXobjects.InstUserdef (tree, i, DrawFrame, dial);
  1671.     END;
  1672.    ELSIF (ex = CircleButton) AND (typ = GBOXCHAR) THEN
  1673.     b:= mtXobjects.InstUserdef (tree, i, DrawCircle, dial);
  1674.    ELSIF (ex = ThreeState) THEN
  1675.     b:= mtXobjects.InstUserdef (tree, i, DrawThreeState, dial);
  1676.    ELSIF (ex = LongEdit) THEN
  1677.     (* Test auf MagiC mit langen Editfeldern *)
  1678.     IF IsMagiCScroll
  1679.     THEN
  1680.       (* Wir machen hier gar nichts, User muž die manuell
  1681.        * initialisieren
  1682.        *)
  1683.     ELSE
  1684.       b:= mtXobjects.InstUserdef (tree, i, DrawEdText, dial);
  1685.       IF ~(cCoords IN tr^[i].obFlags)
  1686.       THEN
  1687.         WITH tr^[i] DO
  1688.           INC (obWidth, CharWidth); 
  1689.           INCL (obFlags, cCoords);
  1690.         END;
  1691.       END;
  1692.     END;
  1693.    ELSE
  1694.     b := TRUE
  1695.    END;
  1696.    IF ~b THEN 
  1697.      (* installierte Userdefs wieder deinstallieren *)
  1698.      DisposeDial (tree);
  1699.      RETURN FALSE 
  1700.    END;
  1701.    IF LASTOB IN dial^.tree^[i].obFlags THEN
  1702.     EXIT;
  1703.    END;
  1704.    INC (i);
  1705.   END; (* LOOP *)
  1706.  END; (* q = NIL *)
  1707.  RETURN TRUE;
  1708. END NewDial;
  1709.  
  1710. PROCEDURE DisposeDial (tree: ADDRESS);
  1711. VAR (*$Reg*)  p: DIALOG;
  1712.     (*$Reg*)  i: sINTEGER;
  1713.     dial: DIALOG;
  1714.     tr  : tObjcTree;
  1715.     ex, typ: sINTEGER;
  1716. BEGIN
  1717.  dial:= GetDIALOG (tree);
  1718.  tr := tree;
  1719.  IF dial # NIL THEN
  1720.   i:= 0;
  1721.   LOOP
  1722.    GetObjcExtype (dial^.tree, i, ex, typ);
  1723.    IF (ex >= MoveBox) AND (ex <= ThreeState) THEN
  1724.     mtXobjects.FreeUserdef (tree, i);
  1725.     IF ex = SpecButton
  1726.     THEN
  1727.       (* Objektkoordinaten wieder zurcksetzen *)
  1728.       IF (cCoords IN tr^[i].obFlags)
  1729.       THEN
  1730.         WITH tr^[i] DO
  1731.           INC (obX, 4); INC(obY, 4);
  1732.           DEC (obWidth, 8); DEC (obHeight, 8);
  1733.           EXCL (obFlags, cCoords);
  1734.         END;
  1735.       END;
  1736.     ELSIF ex = LongEdit
  1737.     THEN
  1738.       IF (cCoords IN tr^[i].obFlags)
  1739.       THEN
  1740.         WITH tr^[i] DO
  1741.           DEC (obWidth, CharWidth);
  1742.           EXCL (obFlags, cCoords);
  1743.         END;
  1744.       END;
  1745.     END;
  1746.    END;
  1747.    IF LASTOB IN dial^.tree^[i].obFlags THEN
  1748.     EXIT;  
  1749.    END;
  1750.    INC (i);
  1751.   END; (* LOOP *)
  1752.   DisposeAREA (dial^.back);
  1753.   DisposeAREA (dial^.front);
  1754.   IF dial # Dials THEN
  1755.    p:= Dials;  WHILE p^.next # dial DO  p:= p^.next;  END;
  1756.    p^.next:= dial^.next;
  1757.   ELSE
  1758.    Dials:= dial^.next;
  1759.   END;
  1760.   DEALLOCATE (dial, 0);  
  1761.  END;
  1762. END DisposeDial;
  1763.  
  1764. PROCEDURE DisposeDials;
  1765. BEGIN
  1766.  WHILE Dials # NIL DO  DisposeDial (Dials^.tree);  END;
  1767. END DisposeDials;
  1768.  
  1769. PROCEDURE InstallHandler (tree: ADDRESS; proc: UserHandler;
  1770.                           callmode, timer, rmode: sINTEGER;
  1771.                           rect: ARRAY OF LOC; mesag: ADDRESS);
  1772. VAR dial: DIALOG;
  1773.     r: POINTER TO ARRAY [0..3] OF sINTEGER;
  1774. BEGIN
  1775.  dial:= GetDIALOG (tree);
  1776.  IF dial # NIL THEN
  1777.   IF (callmode > -1) AND (callmode <= CallByMessage) THEN
  1778.    dial^.proc:= proc;
  1779.    dial^.pmode:= callmode;
  1780.    dial^.ptime:= timer;
  1781.    dial^.prmod:= rmode;
  1782.    r:= ADR (rect);
  1783.    dial^.prect.x:= r^[0];
  1784.    dial^.prect.y:= r^[1];
  1785.    dial^.prect.w:= r^[2];
  1786.    dial^.prect.h:= r^[3];
  1787.    dial^.pmess:= mesag;
  1788.    INCL (dial^.flags, cUser);
  1789.   END;
  1790.  END;
  1791. END InstallHandler;
  1792.  
  1793. PROCEDURE RemoveHandler (tree: ADDRESS);
  1794. VAR dial: DIALOG;
  1795. BEGIN
  1796.  dial:= GetDIALOG (tree);
  1797.  IF dial # NIL THEN
  1798.   EXCL (dial^.flags, cUser);  dial^.pmode:= -1;
  1799.  END;
  1800. END RemoveHandler;
  1801.  
  1802. (*----------------------------------------------------------------------*
  1803.  * Prozeduren unabh„ngig von der Dialogliste                            *
  1804.  *----------------------------------------------------------------------*)
  1805.  
  1806. PROCEDURE DialDraw (tree: ADDRESS; entry, depth: sINTEGER;
  1807.                     cliprect: ARRAY OF LOC; clipping: BOOLEAN);
  1808. VAR p: POINTER TO tRect;
  1809.     r: tRect;
  1810. BEGIN
  1811.  MouseOff;
  1812.  IF clipping THEN
  1813.   p:= ADR (cliprect); r:= p^;  AbsRect (r);
  1814.   SetClipping (PrivateWS, r, TRUE);
  1815.   ObjcDraw (tree, entry, depth, cliprect);
  1816.   SetClipping (PrivateWS, r, FALSE);
  1817.  ELSE
  1818.   ObjcDraw (tree, entry, depth, screen);
  1819.  END;
  1820.  MouseOn;
  1821. END DialDraw; 
  1822.  
  1823. PROCEDURE DialChange (tree: ADDRESS; entry, state: sINTEGER;
  1824.                       clip: ARRAY OF LOC; clipping, set, draw: BOOLEAN);
  1825. BEGIN
  1826.  SetState (tree, entry, state, set);
  1827.  IF draw THEN DialDraw (tree, entry, 0, clip, clipping);  END;
  1828. END DialChange;
  1829.  
  1830. (*----------------------------------------------------------------------*
  1831.  *                      Initalisierung des Dialogs                      *
  1832.  *----------------------------------------------------------------------*)
  1833.  
  1834. PROCEDURE DialCenter (tree: ADDRESS; flag, xx, yy: sINTEGER;
  1835.                       VAR rect: ARRAY OF LOC);
  1836. TYPE PTRVscr = POINTER TO RECORD
  1837.                            cookie:  ARRAY [0..3] OF CHAR;
  1838.                            product: ARRAY [0..3] OF CHAR;
  1839.                            version: sCARDINAL;
  1840.                            vx:      sINTEGER;
  1841.                            vy:      sINTEGER;
  1842.                            vw:      sINTEGER;
  1843.                            vh:      sINTEGER;
  1844.                           END; 
  1845. VAR f:    sINTEGER;
  1846.     a:    ADDRESS;
  1847.     Vscr: PTRVscr;
  1848.     bs:  BITSET;
  1849.     t:    tObjcTree;
  1850. BEGIN
  1851.  t:= tree;
  1852.  IF flag = CPOS THEN
  1853.   t^[0].obX:= xx;  t^[0].obY:= yy;
  1854.  ELSE
  1855.   IF NOT (UsePos IN Config) THEN
  1856.    (* Zentrieren *)
  1857.    FormCenter (t, rect);
  1858.    IF FindCookie (VirtualScreen, a) THEN
  1859.     Vscr:= a;
  1860.     IF Equal (VirtualScreen, Vscr^.cookie) THEN
  1861.      t^[0].obX:= Vscr^.vx + (Vscr^.vw DIV 2) - (t^[0].obWidth DIV 2);
  1862.      t^[0].obY:= Vscr^.vy + (Vscr^.vh DIV 2) - (t^[0].obHeight DIV 2);
  1863.     END; (* IF Equal *)
  1864.    END; (* IF FindCookie *)  
  1865.    IF UseMouse IN Config THEN
  1866.     GrafMkstate (xx, yy, bs, bs);
  1867.     t^[0].obX:= xx - (t^[0].obWidth DIV 2);
  1868.     t^[0].obY:= yy - (t^[0].obHeight DIV 2);
  1869.    END; (* IF UseMouse *)
  1870.   END; (* IF NOT (UsePos IN Config *)
  1871.  END; (* IF flag = CPOS *)
  1872.  (* Screengrenzen prfen *)
  1873.  f:= ObjcFrame (t, 0);  IF f < 0 THEN f:= ABS (f) ELSE f:= 0;  END;
  1874.  WITH t^[0] DO
  1875.   IF (obX + obWidth + f) > screen.w THEN  obX:= screen.w - obWidth - f;  END;
  1876.   IF (obY + obHeight + f) > screen.h THEN  obY:= screen.h - obHeight - f;  END;
  1877.   IF obX < screen.x + f THEN  obX:= screen.x + f;  END;
  1878.   IF obY < screen.y + f THEN  obY:= screen.y + f;  END;
  1879.   CalcArea (tree, 0, rect);
  1880.  END;
  1881. END DialCenter;
  1882.  
  1883. PROCEDURE DialForm (tr: ADDRESS; flag: sINTEGER; VAR smll, big: ARRAY OF LOC);
  1884. VAR i: sINTEGER;
  1885.     clp: tRect;
  1886.     dial: DIALOG;
  1887. BEGIN
  1888.  dial:= GetDIALOG (tr);
  1889.  MouseOff;
  1890.  IF dial # NIL THEN
  1891.   CalcArea (dial^.tree, 0, clp);
  1892.   CASE flag OF
  1893.    DSTART:   IF SaveArea (PrivateWS, dial^.back, clp) THEN
  1894.               INCL (dial^.flags, cMove);
  1895.              ELSE
  1896.               FormDial (FMDSTART, small, clp);
  1897.              END;
  1898.              |
  1899.    DGROW:    IF UseGrowbox IN Config THEN FormDial (FMDGROW, smll, big); END;
  1900.              |
  1901.    DSHRINK:  IF UseGrowbox IN Config THEN FormDial (FMDSHRINK, smll, big); END;
  1902.              |
  1903.    DFINISH:  IF cMove IN dial^.flags THEN
  1904.               RestoreArea (PrivateWS, dial^.back);
  1905.               FreeArea (dial^.back);
  1906.               EXCL (dial^.flags, cMove);
  1907.              ELSE
  1908.               FormDial (FMDFINISH, smll, clp);
  1909.              END;
  1910.              |
  1911.    DDISABLE: IF SaveArea (PrivateWS, dial^.front, clp) THEN
  1912.               INCL (dial^.flags, cRestore);
  1913.              END;
  1914.              MouseOff;
  1915.              i:= SetWritemode (PrivateWS, MagicVDI.REVTRANSPARENT);
  1916.              i:= MagicVDI.SetFillinterior (PrivateWS, 2);
  1917.              i:= MagicVDI.SetFillstyle (PrivateWS, 4);
  1918.              Rect (clp.x, clp.y, clp.w - 1, clp.h - 1, 0);
  1919.              i:= MagicVDI.SetFillstyle (PrivateWS, 0);
  1920.              i:= MagicVDI.SetFillinterior (PrivateWS, 1);
  1921.              i:= SetWritemode (PrivateWS, REPLACE);
  1922.              MouseOn; 
  1923.              |
  1924.    DENABLE:  IF cRestore IN dial^.flags THEN
  1925.               RestoreArea (PrivateWS, dial^.front);
  1926.               FreeArea (dial^.front);
  1927.               EXCL (dial^.flags, cRestore);
  1928.              ELSE
  1929.               ObjcDraw (tr, 0, 8, screen);
  1930.              END;
  1931.              | 
  1932.    ELSE
  1933.   END;
  1934.  END;
  1935.  MouseOn;
  1936. END DialForm;
  1937.  
  1938. (*----------------------------------------------------------------------*
  1939.  *                              Dialoghandling                          *
  1940.  *----------------------------------------------------------------------*)
  1941.  
  1942. PROCEDURE moveDial (t: tObjcTree; x, y: sINTEGER);
  1943. (* Bewegt den Dialog *)
  1944. CONST fly = 2;
  1945. VAR   d, i, xx, yy, e, lt, wm:  sINTEGER;
  1946.       (*$Reg*)  f: sINTEGER;
  1947.       (*$Reg*)  ox: sINTEGER;
  1948.       (*$Reg*)  oy: sINTEGER;
  1949.       butt: sBITSET;
  1950.       blit, moved, b: BOOLEAN;
  1951.       clp, r: tRect;
  1952.       dial: DIALOG;
  1953.       bs:  BITSET;
  1954.  
  1955.  PROCEDURE Redraw (blitten: BOOLEAN);
  1956.  BEGIN
  1957.   IF blitten THEN
  1958.    CopyArea (PrivateWS, area, clp.x, clp.y);
  1959.   ELSE
  1960.     ObjcDraw (t, 0, 8, screen); 
  1961.    
  1962.   END;
  1963.  END Redraw;
  1964.  
  1965. BEGIN
  1966.  dial:= GetDIALOG (t);
  1967.  StoreMouse;
  1968.  moved:= FALSE;
  1969.  IF cMove IN dial^.flags THEN
  1970.   f:= ObjcFrame (dial^.tree, 0);  IF f < 0 THEN f:= ABS (f) ELSE f:= 0;  END;
  1971.   CalcArea (dial^.tree, 0, clp);
  1972.   blit:= SaveArea (PrivateWS, area, clp);
  1973.   ox:= x;  oy:= y;
  1974.   GrafMkstate (xx, yy, butt, bs);
  1975.   MouseHand;
  1976.   IF NOT (UseSolid IN Config) THEN
  1977.    MagicAES.GrafDragbox (clp, bound, xx, yy);
  1978.    moved:= (clp.x # xx) OR (clp.y # yy);
  1979.    IF moved THEN
  1980.     RestoreArea (PrivateWS, dial^.back);
  1981.     dial^.tree^[0].obX:= xx + f;
  1982.     dial^.tree^[0].obY:= yy + f;
  1983.     CalcArea (dial^.tree, 0, clp);
  1984.     b:= SaveArea (PrivateWS, dial^.back, clp);
  1985.     Redraw (blit);
  1986.    END;
  1987.   ELSE
  1988.    LOOP
  1989.     GrafMkstate (x, y, butt, bs);
  1990.     IF NOT (MLinks IN butt) THEN  EXIT;  END;
  1991.     IF (y # oy) OR (x # ox) THEN
  1992.      MoveArea (PrivateWS, dial^.back, x - ox, y - oy, xx, yy);
  1993.      dial^.tree^[0].obX:= xx + f;
  1994.      dial^.tree^[0].obY:= yy + f;
  1995.      ox:= x;  oy:= y;
  1996.      CalcArea (dial^.tree, 0, clp);
  1997.      Redraw (blit);
  1998.     END; (* IF *)
  1999.    END; (* LOOP *)
  2000.   END; (* IF UseSolid *)
  2001.  END; (* IF cMove *)
  2002.  RestoreMouse;
  2003.  FreeArea (area);
  2004. END moveDial;                   
  2005.  
  2006. PROCEDURE hideDial (t: tObjcTree);
  2007. (* Macht Dialog durchsichtig *)
  2008. VAR xx, yy, i:  sINTEGER;
  2009.     butt: sBITSET;
  2010.     blit, b: BOOLEAN;
  2011.     clp: tRect;
  2012.     dial: DIALOG;
  2013.     bs:  BITSET;
  2014. BEGIN
  2015.  dial:= GetDIALOG (t);
  2016.  StoreMouse;
  2017.  IF cMove IN dial^.flags THEN
  2018.   CalcArea (dial^.tree, 0, clp);
  2019.   blit:= SaveArea (PrivateWS, area, clp);
  2020.   RestoreArea (PrivateWS, dial^.back);
  2021.   MouseOff;
  2022.   i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.TRANSPARENT);
  2023.   IF MaxColors > 2 THEN
  2024.    i:= 05555H;  MagicVDI.SetUserlinestyle (PrivateWS, i); (* Pntjes! *)
  2025.    i:= MagicVDI.SetLinetype (PrivateWS, MagicVDI.User); 
  2026.   END;
  2027.   Frame (clp.x + 1, clp.y + 1, clp.w - 3, clp.h - 3, 1);
  2028.   i:= MagicVDI.SetLinetype (PrivateWS, MagicVDI.Line); 
  2029.   i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.REPLACE);
  2030.   MouseBusy;
  2031.   REPEAT  GrafMkstate (xx, yy, butt, bs);  UNTIL (butt = {});
  2032.   IF blit THEN  RestoreArea (PrivateWS, area);
  2033.           ELSE   ObjcDraw (dial^.tree, 0, 8, screen); 
  2034.                 
  2035.   END;
  2036.   RestoreMouse;
  2037.  END;
  2038. END hideDial;
  2039.  
  2040.  
  2041.  
  2042. (*----------------------------------------------------------------------*
  2043.  *          Eventroutine zum Abfragen der Tasten und Mauskn”pfe         *
  2044.  *----------------------------------------------------------------------*)
  2045.  
  2046. PROCEDURE DoEvent (VAR x, y: sINTEGER;
  2047.                    VAR button: sBITSET;
  2048.                    VAR taste: sINTEGER;
  2049.                    VAR kbshift: sBITSET;
  2050.                    VAR scan: sINTEGER;
  2051.                    VAR ascii: CHAR;
  2052.                    VAR clicks: sINTEGER;
  2053.                    tree: ADDRESS): sBITSET;
  2054. VAR event: sBITSET;
  2055.     i:     sINTEGER;
  2056.     split: RECORD
  2057.             CASE: BOOLEAN OF
  2058.              TRUE: wert: sINTEGER;|
  2059.              FALSE: hi: CHAR;
  2060.                     lo: CHAR;|
  2061.             END;
  2062.            END;
  2063.     d: DIALOG; 
  2064. BEGIN
  2065.  (* Array's laden *)
  2066.  event:= {MUKEYBD, MUBUTTON};
  2067.  d:= GetDIALOG (tree);
  2068.  IF d # NIL THEN
  2069.   CASE d^.pmode OF
  2070.    CallByTimer:   INCL (event, MUTIMER);
  2071.                   AESIntIn[14]:= d^.ptime; AESIntIn[15]:= 0;
  2072.                   |
  2073.    CallByRect:    INCL (event, MUM1);
  2074.                   AESIntIn[4]:= d^.prmod;
  2075.                   AESIntIn[5]:= d^.prect.x;
  2076.                   AESIntIn[6]:= d^.prect.y;
  2077.                   AESIntIn[7]:= d^.prect.w;
  2078.                   AESIntIn[8]:= d^.prect.h;
  2079.                   |
  2080.    CallByMessage: INCL (event, MUMESAG);
  2081.                   MagicAES.AESAddrIn[0]:= ADR (d^.pmess);
  2082.                   |
  2083.    ELSE ;
  2084.   END;
  2085.  END;
  2086.  AESIntIn[ 0]:= CastToInt (event);
  2087.  AESIntIn[ 1]:= 258; (* Nicht ganz legal... *)
  2088.  AESIntIn[ 2]:= 3;
  2089.  AESIntIn[ 3]:= 0;
  2090.  i:= AESCall(25, 16, 7, 1, 0);
  2091.  event:= CastToBitset (i);
  2092.  x:= AESIntOut[1];
  2093.  y:= AESIntOut[2];
  2094.  button:= CastToBitset (AESIntOut[3]);
  2095.  kbshift:= CastToBitset (AESIntOut[4]);
  2096.  split.wert:= AESIntOut[5];
  2097.  taste:= split.wert;
  2098.  scan:= CastToInt (split.hi);
  2099.  ascii:= split.lo;
  2100.  clicks:= AESIntOut[6];
  2101.  RETURN event;
  2102. END DoEvent;
  2103.  
  2104.  
  2105. (*----------------------------------------------------------------------*
  2106.  *                      Neue Objekt-Edit Funktionen                     *
  2107.  *                                                                      *
  2108.  *  Idee und Ausfhrung: Dirk Steins                                    *
  2109.  *                                                                      *
  2110.  *  Umgeschrieben und auf Lauff„higkeit mit anderen Compilern angepasst *
  2111.  *  (SPC und LPR kennen kein SET OF CHAR): Peter Hellinger              *
  2112.  *----------------------------------------------------------------------*)
  2113.  
  2114. TYPE PtrMaxStr = POINTER TO ARRAY [0..255] OF CHAR;
  2115.  
  2116. (* Einige Variable wurden global deklariert, damit sie nicht in jeder
  2117.  * Subprozedur zu ObjcEdit neu ermittelt werden mssen. Das spart Zeit
  2118.  * und Code. Die Variablen werden bei jedem ObjcEdit-Aufruf neu gesetzt,
  2119.  * um immer dem aktuellen Objekt zu entsprechen.
  2120.  *)
  2121.  
  2122. VAR  spec:      MagicAES.PtrTEDINFO; (* Zeiger auf die TeD-Struktur *)
  2123.      storestr:  ARRAY [0..255] OF CHAR;
  2124.      ptmplt:    PtrMaxStr;
  2125.      ptext:     PtrMaxStr;
  2126.      pvalid:    PtrMaxStr; (* die Strings im TeD-Objekt *)
  2127.      rect:      tRect;     (* Umgebungsrechteck des Objekts *)
  2128.      wbox:      sINTEGER;  (* Fontgr”že *)
  2129.      hbox:      sINTEGER;
  2130.      viewlen:   sINTEGER;
  2131.      leftOffs:  sINTEGER;
  2132.  
  2133. PROCEDURE isalnum (ch: CHAR): BOOLEAN;
  2134. BEGIN
  2135.  RETURN ((ch > '/') AND (ch < ':')) OR
  2136.         ((CAP (ch) > '@') AND (CAP (ch) < '['));
  2137. END isalnum;
  2138.  
  2139. PROCEDURE valid (idx: sINTEGER; VAR edchar: CHAR): BOOLEAN;
  2140. VAR len: sINTEGER;
  2141.  
  2142.  PROCEDURE isspace (ch: CHAR): BOOLEAN;
  2143.  BEGIN  RETURN (ch > 10C) OR (ch < 14C) OR (ch = ' ');  END isspace;
  2144.  
  2145.  PROCEDURE isdigit (ch: CHAR): BOOLEAN;
  2146.  (* Extension: Bei Zahleingaben ist auch + und - erlaubt *)
  2147.  BEGIN
  2148.   RETURN ((ch > '/') AND (ch < ':')) OR ((ch = '+') OR (ch = '-'));
  2149.  END isdigit;
  2150.  
  2151.  PROCEDURE isalpha (ch: CHAR): BOOLEAN;
  2152.  BEGIN  RETURN (CAP (ch) > '@') AND (CAP (ch) < '[');  END isalpha;
  2153.  
  2154.  PROCEDURE isextchr (ch: CHAR; REF extchr: ARRAY OF CHAR): BOOLEAN;
  2155.  VAR i: sCARDINAL;
  2156.  BEGIN
  2157.   FOR i:= 0 TO HIGH (extchr) DO
  2158.    IF extchr[i] = ch THEN  RETURN TRUE;  END;
  2159.   END;
  2160.   RETURN FALSE;
  2161.  END isextchr;
  2162.  
  2163. BEGIN
  2164.  len:= Length (pvalid^); (* sINTEGER und sCARDINAL sind Zuweisungskomaptibel! *)
  2165.  IF idx > len - 1 THEN  idx:= len - 1;  END;
  2166.  CASE pvalid^[idx] OF
  2167.   'X': RETURN TRUE;
  2168.        |
  2169.   'x': edchar:= Cap (edchar);  RETURN TRUE;
  2170.        |
  2171.   '9': RETURN isdigit (edchar);
  2172.        |
  2173.   'A',
  2174.   'N': IF isalpha (edchar) OR (edchar = ' ') OR
  2175.           ((ORD (edchar) >= 194) AND (ORD (edchar) <= 220)) OR 
  2176.           (isextchr (edchar, '€Ž’™š¥µ¶·¸á')) THEN
  2177.         edchar:= Cap (edchar);
  2178.         RETURN TRUE;
  2179.        END;
  2180.        |
  2181.   'P',
  2182.   'p',
  2183.   'F': IF isalnum (edchar) OR (ORD(edchar)> 128) OR
  2184.           isextchr (edchar, '\?*:._')  THEN
  2185.         edchar:= Cap (edchar);  RETURN TRUE;
  2186.        END;
  2187.        |
  2188.   'f': IF isalnum (edchar) OR (ORD(edchar) > 128) OR (edchar = '_') THEN
  2189.         edchar:= Cap (edchar);  RETURN TRUE
  2190.        END;
  2191.        |
  2192.   'a',
  2193.   'n': IF isalpha (edchar) OR isspace (edchar) OR (ORD (edchar) > 128) THEN
  2194.         RETURN TRUE
  2195.        END;
  2196.        |
  2197.   ELSE
  2198.  END;
  2199.  RETURN FALSE;
  2200. END valid;
  2201.  
  2202. PROCEDURE GetCursor (idx: sINTEGER; VAR newidx: sINTEGER;
  2203.                      index: BOOLEAN): sINTEGER;
  2204. (* Liefert Cursor oder Indexposition *)
  2205. VAR (*$Reg*)  cpos: sINTEGER;
  2206.     (*$Reg*)  i: sINTEGER;
  2207.     (*$Reg*)  j: sINTEGER;
  2208. BEGIN
  2209.  i:= 0;  cpos:= 0;
  2210.  (* IF ptext^[0] = '@' THEN  ptext^[0]:= 0c;  END; *)
  2211.  (* Ende der Maske suchen *)
  2212.  WHILE (ptmplt^[cpos] # '_') AND (ptmplt^[cpos] # 0c) DO INC (cpos); END;
  2213.  (* Position bestimmen *)
  2214.  IF index THEN  j:= cpos;  ELSE j:= i;  END;
  2215.  WHILE (j < idx) AND (ptmplt^[cpos] # 0c) AND (ptext^[i] # 0c) DO
  2216.   INC (cpos);
  2217.   IF (pvalid^[i+1] # 0c) THEN
  2218.    WHILE (ptmplt^[cpos] # '_') AND (ptmplt^[cpos] # 0c) DO INC (cpos) END;
  2219.   END;
  2220.   INC(i);
  2221.   IF index THEN  j:= cpos;  ELSE j:= i;  END;
  2222.  END;
  2223.  IF index THEN  RETURN i;  END;
  2224.  IF (i < idx) THEN newidx:= i END;
  2225.  RETURN cpos
  2226. END GetCursor;
  2227.  
  2228. CONST SMALL =           5;
  2229.       TELEFT =          0;
  2230.       TERIGHT =         1;
  2231.       TECENTER =        2;
  2232.  
  2233. VAR oldPos:  sINTEGER;
  2234.     insMode: BOOLEAN;
  2235.  
  2236. PROCEDURE JustPos (): sINTEGER;
  2237. VAR cx: sINTEGER;
  2238. BEGIN
  2239.  IF spec^.teJust = TERIGHT THEN
  2240.   RETURN rect.x + rect.w; (* - (wbox * (spec^.teTmplen-1))); *)
  2241. (*  RETURN rect.x + (rect.w - (wbox * (spec^.teTmplen-1)));  *)
  2242.  ELSIF spec^.teJust = TECENTER THEN
  2243.   RETURN rect.x + (rect.w - (wbox * (spec^.teTmplen-1))) DIV 2;
  2244.  ELSE
  2245.   RETURN rect.x;
  2246.  END;
  2247. END JustPos;
  2248.  
  2249. PROCEDURE drawCursor (cpos: sINTEGER);
  2250. VAR i, cx, cy: sINTEGER;
  2251.     xadd     : sINTEGER;
  2252. BEGIN
  2253.  cy:= rect.y;  INC (cy, (rect.h - hbox) DIV 2);  cx:= JustPos ();
  2254.  i:= SetWritemode (PrivateWS, XOR);
  2255.  MouseOff();
  2256.  IF spec^.teJust = TERIGHT THEN
  2257.    xadd := - (wbox * (INTEGER(LENGTH(ptext^)) - cpos));
  2258.  ELSE
  2259.    xadd := wbox * cpos;
  2260.  END;
  2261.  DEC (xadd, leftOffs * wbox);
  2262.  IF insMode THEN (* Cursor ist ein Strich *)
  2263.   Line (cx + xadd, cy - 1, 0, hbox + 1);
  2264.  ELSE (* šberschreibmodus, Cursor ist ein Block *)
  2265.   Rect (cx + xadd, cy - 1, wbox - 1, hbox + 1, MagicAES.BLACK);
  2266.  END;
  2267.  MouseOn();
  2268.  i:= SetWritemode (PrivateWS, REPLACE);
  2269. END drawCursor;
  2270.  
  2271. TYPE NormKey = (CurRight, CurLeft, CurUp, CurDown,
  2272.                 ShCurLeft, ShCurRight, ShCurUp, ShCurDown,
  2273.                 CtrlCurRight, CtrlCurLeft, CtrlCurUp, CtrlCurDown,
  2274.                 Ins, ShiftIns, ShHome, CtrlHome, CtrlC, CtrlX, CtrlV, Home, BackSpace, 
  2275.                 Del, Escape, null, noKey);
  2276.  
  2277. PROCEDURE normkey (kstate: sBITSET; VAR ch: sINTEGER): NormKey;
  2278. VAR scan, ascii: CHAR;
  2279.     nk: NormKey;
  2280. BEGIN
  2281.  at.lint:= ch;  scan:= CastToChar (at.b2);  ascii:= CastToChar (at.b1);
  2282.  nk:= noKey;
  2283.  IF (KRSHIFT IN kstate) OR (KLSHIFT IN kstate) THEN  (* Shift *)
  2284.   CASE ORD(scan) OF
  2285.    54, 77: nk:= ShCurRight;|
  2286.    42, 75: nk:= ShCurLeft;|
  2287.        72: nk:= ShCurUp;|
  2288.        80: nk:= ShCurDown;|
  2289.        82: nk:= ShiftIns;|
  2290.        71: nk:= ShHome;
  2291.    ELSE
  2292.   END;
  2293.  ELSIF (KCTRL IN kstate) THEN (* Control *)
  2294.   CASE ORD(scan) OF
  2295.    54, 77, 116: nk:= CtrlCurRight;|
  2296.    42, 75, 115: nk:= CtrlCurLeft;|
  2297.             72: nk:= CtrlCurUp;|
  2298.             80: nk:= CtrlCurDown;|
  2299.             71: nk:= CtrlHome; |
  2300.             45: nk:= CtrlX; |
  2301.             46: nk:= CtrlC; |
  2302.             47: nk:= CtrlV; |
  2303.   ELSE
  2304.   END;
  2305.  ELSIF (KALT IN kstate) THEN (* Alt *)
  2306.  ELSE (* nichts *)
  2307.   CASE ORD(scan) OF
  2308.     1: nk:= Escape;|
  2309.    14: nk:= BackSpace;|
  2310.    71: nk:= Home;|
  2311.    72: nk:= CurUp;|
  2312.    75: nk:= CurLeft;|
  2313.    77: nk:= CurRight;|
  2314.    80: nk:= CurDown;|
  2315.    82: nk:= Ins;|
  2316.    83: nk:= Del;|
  2317.    ELSE
  2318.   END;
  2319.  END;
  2320.  RETURN nk
  2321. END normkey;
  2322.  
  2323. PROCEDURE MemCopy (to, from: ADDRESS; l: sINTEGER);
  2324. VAR f, t: POINTER TO LOC;
  2325.     i: sINTEGER;
  2326. BEGIN
  2327.  f:= from;  t:= to;
  2328.  IF CastToAddr (t) > CastToAddr (f) THEN
  2329.   INC(t,l-1);  INC(f,l-1);
  2330.   FOR i:= l-1 TO 0 BY -1 DO t^:= f^ ; DEC(t); DEC (f); END;
  2331.  ELSE
  2332.   FOR i:= 0 TO l-1 DO t^:= f^; INC (t); INC(f); END;
  2333.  END;
  2334. END MemCopy;
  2335.  
  2336. PROCEDURE MemFill (to: ADDRESS; v: sINTEGER; l: sINTEGER);
  2337. VAR t: POINTER TO Byte;
  2338.     val: Byte;
  2339.     i: sINTEGER;
  2340. BEGIN
  2341.  t:= to;  val:= CastToByte (v);
  2342.  FOR i:= 0 TO l - 1 DO  t^:= val;  INC(t);  END;
  2343. END MemFill;
  2344.  
  2345. PROCEDURE doAsciiTab (careForRect: BOOLEAN; VAR ch : CHAR): BOOLEAN;
  2346.  (* Dialoghandling fr Char-Insert *)
  2347.  VAR work: tRect;
  2348.      res : BOOLEAN;
  2349.      i, voidI, mx, my, wx, wy: sINTEGER;
  2350. BEGIN
  2351.   DialCenter (asciitab, CSCREEN, 0, 0, dummy);
  2352.  
  2353.   IF careForRect
  2354.   THEN
  2355.     (* Aufpassen, daá er Eingabefeld nicht berdeckt! *)
  2356.  
  2357.     ObjcArea (asciitab, 0, work);
  2358.     (* šber Eingabefeld plazieren *)
  2359.     work.y:= rect.y - work.h - CharHeight * 2;
  2360.  
  2361.     IF work.y < screen.y THEN
  2362.      (* unter Eingabefeld plazieren *)
  2363.      work.y:= rect.y + rect.h + CharHeight * 2;
  2364.      IF work.y + work.h > screen.y + screen.h THEN
  2365.       DialCenter (asciitab, CSCREEN, 0, 0, dummy);
  2366.      END;
  2367.     END;
  2368.  
  2369.     SetObjcRect (asciitab, 0, work);
  2370.   END;
  2371.  
  2372.   DialForm (asciitab, DSTART, dummy, dummy);
  2373.   DialDraw (asciitab, 0, 8, clip, FALSE);
  2374.   res := FALSE;
  2375.  
  2376.   LOOP (* erg„nzt durch Hp *)
  2377.     event:= DoEvent (mx, my, button, taste, kbshift, scan, ascii, clicks, NIL);
  2378.     IF (MUBUTTON IN event) THEN
  2379.      voidI:= ObjcFind (asciitab, 0, MAX(sINTEGER), mx, my);
  2380.  
  2381.      IF (voidI = 1) THEN  (* Dialog bewegen *)
  2382.       moveDial (asciitab, mx, my);
  2383.  
  2384.      ELSIF (voidI < 0) AND (MLinks IN button) THEN (* Ausserhalb, weg damit *)
  2385.       Bounce; (* Maustaste entprellen *)
  2386.       EXIT; (* Nix gew„hlt, fertisch... *)
  2387.  
  2388.      ELSIF (MLinks IN button) THEN (* Buchstaben suchen *)
  2389.       Bounce; (* Maustaste entprellen *)
  2390.       ObjcPos (asciitab, voidI, wx, wy);
  2391.       i:= ((mx - wx) DIV ChWidth); (* Position des Zeichens *)
  2392.       IF i < 0 THEN i:= 0;  END;
  2393.       IF asciitab^[voidI].obType = GSTRING THEN
  2394.        ch:= asciitab^[voidI].obSpec.StringPtr^[i];
  2395.        IF ch # ' ' THEN res := TRUE; EXIT;  END;
  2396.       END;
  2397.      END; 
  2398.     END; 
  2399.     IF (MUKEYBD IN event) AND (scan = 97) THEN EXIT; END; (* UNDO *)
  2400.   END; (* Loop *)
  2401.   DialForm (asciitab, DFINISH, dummy, dummy);
  2402.   RETURN res;
  2403. END doAsciiTab;
  2404.  
  2405. PROCEDURE editObject (tree: tObjcTree; obj: sINTEGER; kstate: sBITSET; edchar: sINTEGER;
  2406.                       VAR idx: sINTEGER; kind: sINTEGER; mode: BOOLEAN; nextObj: sINTEGER);
  2407. VAR err, i, i2, j, cpos, new, extyp, mx, my, wx, wy, ob, voidI, len, l: sINTEGER;
  2408.     c: sCARDINAL;
  2409.     mb: sBITSET;
  2410.     knorm: NormKey;
  2411.     adr: ADDRESS;
  2412.     tmpltFound, move: BOOLEAN;
  2413.     edCh: ARRAY [0..0] OF CHAR;
  2414.     draw: BOOLEAN;
  2415.     isExt: BOOLEAN;
  2416.  
  2417.  PROCEDURE InsertNormalChar;
  2418.  BEGIN   
  2419.   c:= 0FFH;  BitOp (and, edchar, c, edchar);  edCh[0]:= CastToChar (edchar);
  2420.   cpos:= GetCursor (idx, idx, FALSE);  tmpltFound:= FALSE;
  2421.   IF (edCh[0] # '_') AND (edCh[0] # 0c) THEN
  2422.  
  2423.    (* Suche nach Template-Zeichen ab cPos in M2 *)
  2424.    j:= cpos;
  2425.    LOOP
  2426.     j:= Pos (edCh, ptmplt^, j, FALSE);  len:= Length (ptmplt^);
  2427.     IF j < len THEN
  2428.      IF (ptmplt^[j+1] = '_') AND (ptmplt^[j-1] = '_') THEN
  2429.       tmpltFound:= TRUE;  EXIT  (* Template gefunden *)
  2430.      END;
  2431.      INC (j);
  2432.     ELSE
  2433.      EXIT
  2434.     END;
  2435.    END; (* LOOP *)
  2436.   END; (* IF CastToChar (edchar) # '_' ... *)
  2437.  
  2438.   IF tmpltFound THEN
  2439.    ptext^[idx]:= 0c; (* String terminieren *)
  2440.    WHILE cpos # j DO
  2441.     IF ptmplt^[cpos] = '_' THEN
  2442.      (* Leerzeichen einfgen *)
  2443.      editObject (tree, obj, {}, 32, idx, kind, TRUE, nextObj);
  2444.     END;
  2445.     INC (cpos);
  2446.    END; (* WHILE *)
  2447.    draw := TRUE;
  2448.    (*
  2449.    ObjcDraw (tree, obj, 0, screen);
  2450.    *)
  2451.  
  2452.   ELSE (* Kein Template-Zeichen eingegeben *)
  2453.    IF (edCh[0] # 0c) AND (mode OR valid (idx, edCh[0])) THEN
  2454.     len:= Length (pvalid^);
  2455.     IF idx < len THEN
  2456.      IF insMode THEN
  2457.       adr:= ADR (ptext^[idx]);
  2458.       l:= Length (ptext^);  (* l:= Length (pvalid^); *)
  2459.       IF l < len  THEN  MemCopy (adr + LONG (1), adr, l - idx + 1);
  2460.                   ELSE  MemCopy (adr + LONG (1), adr, l - idx - 1);
  2461.       END;
  2462.      ELSE (* Auf String-Terminierung achten *)
  2463.       IF (ptext^[idx] = 0c) THEN ptext^[idx+1]:= 0c END;
  2464.      END;
  2465.      ptext^[idx]:= edCh[0];
  2466.     ELSE
  2467.      ptext^[idx-1]:= edCh[0];
  2468.     END; (* IF idx < ... *)
  2469.     (*
  2470.     IF idx < Min (Length (ptext^), Length (pvalid^)) THEN  INC(idx);  END;
  2471.     *)
  2472.     IF idx < spec^.teTxtlen THEN  INC(idx);  END;
  2473.     IF NOT mode THEN
  2474.      draw := TRUE;
  2475.      (*
  2476.      ObjcDraw (tree, obj, 0, screen);
  2477.      *)
  2478.     END;
  2479.    END; (* IF  edCH # 0c .... *)
  2480.   END; (* IF tmpltFound (p # NIL..) *)
  2481.  END InsertNormalChar;
  2482.  
  2483.  PROCEDURE CharInsert;
  2484.  (* Dialoghandling fr Char-Insert *)
  2485.  VAR work: tRect;
  2486.      ch  : CHAR;
  2487.      res : BOOLEAN;
  2488.  BEGIN
  2489.   IF pvalid^[idx] = 'X' THEN
  2490.    MagicAES.WindUpdate (BEGMCTRL);
  2491.    res := doAsciiTab (TRUE, ch);
  2492.    MagicAES.WindUpdate (ENDMCTRL);
  2493.    IF res
  2494.    THEN
  2495.      edchar := ORD (ch);
  2496.      InsertNormalChar();
  2497.    END;
  2498.   END;
  2499.  END CharInsert;
  2500.  
  2501.  PROCEDURE EdInit;
  2502.  BEGIN
  2503.   leftOffs := 0;
  2504.   len:= Length(ptext^); 
  2505.   IF (idx < 0) OR (idx > len) THEN  idx:= len;  END;
  2506.   IF isExt
  2507.   THEN
  2508.     leftOffs := spec^.teFontid;
  2509.     (*
  2510.     spec^.teFontid := 0;
  2511.     *)
  2512.     IF idx > leftOffs+viewlen
  2513.     THEN
  2514.       idx := leftOffs
  2515.     ELSIF idx < leftOffs
  2516.     THEN
  2517.       leftOffs := Max (idx - viewlen, 0);
  2518.     END;
  2519.     IF len < viewlen
  2520.     THEN
  2521.       leftOffs := 0;
  2522.     END;
  2523.     spec^.teFontid := leftOffs;
  2524.   END;
  2525.   cpos:= GetCursor (idx, idx, FALSE);
  2526.   IF NOT mode THEN drawCursor (cpos); END;
  2527.   oldPos:= cpos;
  2528.  END EdInit;
  2529.  
  2530.  PROCEDURE getScrap (VAR scrap: ARRAY OF CHAR): BOOLEAN;
  2531.    CONST scrapName = 'SCRAP.TXT';
  2532.    VAR b : BITSET;
  2533.  BEGIN
  2534.   b := MagicAES.ScrpRead(scrap);
  2535.   IF b = {} THEN RETURN FALSE END;
  2536.   IF scrap[0] = 0C THEN RETURN FALSE END;
  2537.   IF scrap[Length(scrap)-1] # '\'
  2538.   THEN
  2539.     Append('\', scrap);
  2540.   END;
  2541.   Append (scrapName, scrap);
  2542.   RETURN TRUE
  2543.  END getScrap;
  2544.  
  2545.  PROCEDURE writeToClip (REF str : ARRAY OF CHAR): BOOLEAN;
  2546.    VAR name : ARRAY [0..255] OF CHAR;
  2547.        hdl  : sINTEGER;
  2548.        cnt  : LONGCARD;
  2549.  BEGIN
  2550.    IF ~getScrap (name) THEN RETURN FALSE END;
  2551.    hdl := MagicDOS.Fcreate (name, {});
  2552.    IF hdl < 0 THEN RETURN FALSE END;
  2553.    cnt := LENGTH (str);
  2554.    MagicDOS.Fwrite (hdl, cnt, CADR(str));
  2555.    hdl := MagicDOS.Fclose (hdl);
  2556.    RETURN TRUE;
  2557.  END writeToClip;
  2558.  
  2559.  PROCEDURE readFromClip ();
  2560.    CONST    CR  = 15C;
  2561.             LF  = 12C;
  2562.    VAR name : ARRAY [0..255] OF CHAR;
  2563.        hdl  : sINTEGER;
  2564.        cnt  : LONGCARD;
  2565.        char : CHAR;
  2566.  BEGIN
  2567.    IF ~getScrap (name) THEN RETURN END;
  2568.    hdl := MagicDOS.Fopen (name, MagicDOS.Read);
  2569.    IF hdl < 0 THEN RETURN END;
  2570.    cnt := 1;
  2571.    REPEAT
  2572.      MagicDOS.Fread (hdl, cnt, ADR(char));
  2573.      IF (cnt = 1) & (char # CR) & (char # LF)
  2574.      THEN
  2575.        editObject (tree, obj, {}, ORD (char), idx, kind, TRUE, nextObj);
  2576.      END;
  2577.    UNTIL (cnt # 1);
  2578.    hdl := MagicDOS.Fclose (hdl);
  2579.  END readFromClip;
  2580.  
  2581.  PROCEDURE EdChar;
  2582.  BEGIN
  2583.   draw := FALSE;
  2584.   knorm:= normkey (kstate, edchar);
  2585.   IF (oldPos # -1) AND NOT mode THEN (* alten Cursor l”schen *)
  2586.    drawCursor (oldPos); 
  2587.   END;
  2588.   CASE knorm OF
  2589.     CtrlX,
  2590.     CtrlC:      IF writeToClip (ptext^) &
  2591.                    (knorm = CtrlX)
  2592.                 THEN
  2593.                   (* Editfeld l”schen *)
  2594.                   knorm := Escape;
  2595.                 END; |
  2596.     CtrlV:      readFromClip (); 
  2597.                 draw := TRUE; |
  2598.   ELSE
  2599.   END;
  2600.   CASE knorm OF
  2601.    ShHome:      Assign (ptext^, storestr);
  2602.                 |
  2603.    Home:        Assign (storestr, ptext^);
  2604.                 idx:= 0;
  2605.                 draw := TRUE;
  2606.                 (*
  2607.                 ObjcDraw (tree, obj, 0, screen);
  2608.                 *)
  2609.                 |
  2610.    CurLeft:     IF idx > 0 THEN  DEC (idx);  END;
  2611.                 |
  2612.    ShCurLeft:   idx:= 0;
  2613.                 |
  2614.    CurRight:    IF idx < Min (Length (ptext^), Length (pvalid^)) THEN  INC(idx);  END;
  2615.                 |
  2616.    ShCurRight:  idx:= Min (Length(ptext^), Length (pvalid^));
  2617.                 |
  2618.    Ins:         insMode:= NOT insMode; 
  2619.                 |
  2620.    ShiftIns:    CharInsert;
  2621.                 |
  2622.    null:        i2:= idx;  i:= -1;  cpos:= 0;
  2623.                 REPEAT
  2624.                  INC (i);
  2625.                  WHILE (ptmplt^[cpos] # '_') AND
  2626.                        (ptmplt^[cpos] # 0c) DO  INC (cpos)  END;
  2627.                  INC (cpos);
  2628.                 UNTIL NOT ((i2 > cpos-1) AND (ptmplt^[cpos] # 0c) AND 
  2629.                            (ptext^[i] # 0c) (* AND (ptext^[i] # '@') *) );
  2630.                 idx:= i;
  2631.                 |
  2632.    Del:         IF ptext^[idx] # 0c THEN
  2633.                  adr:= ADR (ptext^[idx]);  len:= Length (ptext^);
  2634.                  MemCopy (adr, adr + LONG(1), len - idx);
  2635.                  (*
  2636.                  ObjcDraw (tree, obj, 0, screen);
  2637.                  *)
  2638.                  draw := TRUE;
  2639.                 END;
  2640.                 |
  2641.    BackSpace:   IF (idx > 0) AND (ptext^[idx-1] # 0c) THEN
  2642.                  adr:= CastToAddr(ptext) + CastToAddr (idx);
  2643.                  len:= Length (ptext^);
  2644.                  MemCopy (adr - LONG(1), adr, len - idx + 1);
  2645.                  DEC (idx);
  2646.                  (* 
  2647.                  ObjcDraw (tree, obj, 0, screen);
  2648.                  *)
  2649.                  draw := TRUE 
  2650.                 END;
  2651.                 |
  2652.    Escape:      MemFill (ptext, 0, Length (pvalid^));
  2653.                 idx:= 0;  
  2654.                 draw := TRUE;
  2655.                 (*
  2656.                 ObjcDraw (tree, obj, 0, screen);
  2657.                 *)
  2658.                 |
  2659.    CtrlCurRight: WHILE (ptext^[idx] # 0c) AND (isalnum (ptext^[idx]) OR
  2660.                        (ORD(ptext^[idx]) > 127)) DO  INC(idx);  END;
  2661.                  WHILE (ptext^[idx] # 0c) AND NOT ((isalnum (ptext^[idx]) OR
  2662.                        (ORD(ptext^[idx]) > 127))) DO  INC(idx);  END;
  2663.                  |
  2664.    CtrlCurLeft:  WHILE (idx > 0) AND NOT ((isalnum (ptext^[idx-1]) OR
  2665.                        (ORD(ptext^[idx-1]) > 127))) DO  DEC(idx);  END;
  2666.                  WHILE (idx > 0) AND (isalnum (ptext^[idx-1]) OR
  2667.                        (ORD(ptext^[idx-1]) > 127)) DO  DEC(idx);  END;
  2668.                  |
  2669.    CtrlX,
  2670.    CtrlC,
  2671.    CtrlV: |
  2672.    ELSE          InsertNormalChar();
  2673.   END (* CASE normkey *);
  2674.   cpos:= GetCursor (idx, idx, FALSE);
  2675.   IF isExt
  2676.   THEN
  2677.     IF idx <= leftOffs
  2678.     THEN
  2679.       leftOffs := Max (0, idx-1);
  2680.       draw := TRUE;
  2681.     ELSIF idx >= leftOffs + viewlen
  2682.     THEN
  2683.       leftOffs := idx - viewlen;
  2684.       draw := TRUE;
  2685.     END;
  2686.     spec^.teFontid := leftOffs;
  2687.   END;
  2688.   IF draw & ~mode THEN
  2689.     ObjcDraw (tree, obj, 0, screen);
  2690.   END;
  2691.   IF NOT mode THEN drawCursor (cpos) END;
  2692.   oldPos:= cpos;
  2693.  END EdChar;
  2694.  
  2695. BEGIN
  2696.  GetObjcExtype (tree, obj, extyp, ob);
  2697.  isExt := extyp = LongEdit;
  2698.  IF (EDITABLE IN tree^[obj].obFlags) AND
  2699.   ((ob = GFTEXT) OR (ob = GFBOXTEXT)) THEN
  2700.   IF kind = EDINIT THEN 
  2701.    EdInit;
  2702.   ELSIF kind = EDCHAR THEN
  2703.    EdChar;
  2704.   ELSIF kind = EDEND THEN
  2705.    IF (oldPos # -1) AND NOT mode THEN  drawCursor (oldPos);  END;
  2706.    IF isExt
  2707.    THEN
  2708.      leftOffs := 0;
  2709.      (* spec^.teFontid := 0;
  2710.      ObjcDraw (tree, obj, 0, screen);
  2711.      *)
  2712.    END;
  2713.    oldPos:= -1;
  2714.   END; (* IF *)
  2715.  END; (* IF EDITABLE *)
  2716. END editObject;
  2717.  
  2718. PROCEDURE UpdateEdobj (tree: ADDRESS; object: sINTEGER);
  2719. VAR t: tObjcTree;
  2720. BEGIN
  2721.  t:= tree;  spec:= mtXobjects.GetObSpec (t, object); 
  2722.  IF spec^.teFont = SMALL THEN  wbox:= 6;  hbox:= 6;
  2723.                          ELSE  wbox:= ChWidth;  hbox:= CharHeight;
  2724.  END;
  2725.  ptmplt:= CastToAddr (spec^.tePtmplt);
  2726.  ptext:=  CastToAddr (spec^.tePtext);
  2727.  pvalid:= CastToAddr (spec^.tePvalid);
  2728.  ObjcArea (tree, object, rect);
  2729.  viewlen := t^[object].obWidth DIV ChWidth;
  2730.  IF cCoords IN t^[object].obFlags
  2731.  THEN
  2732.    DEC (viewlen);
  2733.    DEC (rect.w, ChWidth);
  2734.  END;
  2735. END UpdateEdobj;
  2736.  
  2737. PROCEDURE ObjcEdit (tree: ADDRESS; object: sINTEGER; VAR pos: sINTEGER;
  2738.                     char, kind: sINTEGER);
  2739. (* Zus„tzlich ben”tigt wird: 
  2740.  * kstate: Tastaturstatus (steht in glob. Var)
  2741.  * mode  : Irgendwas mit Cursorzeichnen oder nicht
  2742.  * next_obj: Index des n„chsten zu editierenden Objektes
  2743.  *)
  2744. VAR res:     sINTEGER;
  2745.     nextObj: sINTEGER;
  2746.     txtLen, tmpltLen : sINTEGER;
  2747. BEGIN
  2748.  IF ~IsMagiCScroll THEN
  2749.   UpdateEdobj (tree, object);
  2750.   editObject (tree, object, kbshift, char, pos, kind, FALSE, nextObj);
  2751.  ELSE
  2752.   (* Workaround fr WindowDials *)
  2753.   IF (pos < 0) THEN  pos:= lastPos; END;
  2754.   MagicAES.ObjcEdit (tree, object, pos, char, kind);
  2755.   lastPos := pos;
  2756.  END;
  2757. END ObjcEdit;
  2758.  
  2759. (*
  2760. PROCEDURE DoConfig (tree: ADDRESS; mx, my: sINTEGER);
  2761. (* Die Werte hier sind abh„ngig von den Eintr„gen in confdial! *)
  2762. VAR   i, j: sINTEGER;
  2763.  
  2764.  PROCEDURE SwitchKey (von, nach: sBITSET);
  2765.  VAR j: sINTEGER;
  2766.      d: DIALOG;
  2767.  BEGIN
  2768.   d:= GetDIALOG (tree);
  2769.   FOR j:= 0 TO MaxKeys DO
  2770.    WITH d^.keys[j] DO
  2771.     IF scan = -1 THEN  RETURN;  END;
  2772.     IF kbstate = von THEN  kbstate:= nach;  END;
  2773.    END; 
  2774.   END; 
  2775.  END SwitchKey;
  2776.  
  2777.  PROCEDURE SwitchConfig (flag: CARDINAL);
  2778.  BEGIN
  2779.   IF flag IN Config THEN EXCL (Config, flag)  ELSE  INCL (Config, flag)  END;
  2780.  END SwitchConfig;
  2781.  
  2782. BEGIN
  2783.  IF UseConfig IN Config THEN
  2784.   SetState (confdial, 1, CHECKED, UseALT     IN Config);
  2785.   SetState (confdial, 2, CHECKED, NOT (UseALT IN Config));
  2786.   SetState (confdial, 3, CHECKED, UseSolid   IN Config);
  2787.   SetState (confdial, 4, CHECKED, UseEdit    IN Config);
  2788.   SetState (confdial, 5, CHECKED, UseCenter  IN Config);
  2789.   SetState (confdial, 6, CHECKED, UseMouse   IN Config);
  2790.   SetState (confdial, 7, CHECKED, UsePos     IN Config);
  2791.   SetState (confdial, 8, CHECKED, UseGrowbox IN Config);
  2792.   i:= TreePopup (confdial, mx - (10 * ChWidth), my, 2);
  2793.   CASE i OF
  2794.    1: INCL (Config, UseALT); ShortKey:= {KALT};  SwitchKey ({KCTRL}, {KALT});|
  2795.    2: EXCL (Config, UseALT); ShortKey:= {KCTRL}; SwitchKey ({KALT}, {KCTRL});|
  2796.    3: SwitchConfig (UseSolid);|
  2797.    4: SwitchConfig (UseEdit);|
  2798.    5: SwitchConfig (UseCenter);
  2799.       IF UseCenter IN Config THEN  Config:= Config - {UseMouse, UsePos};  END;|
  2800.    6: SwitchConfig (UseMouse);
  2801.       IF UseMouse IN Config THEN  Config:= Config - {UseCenter, UsePos};  END;|
  2802.    7: SwitchConfig (UsePos);
  2803.       IF UsePos IN Config THEN  Config:= Config - {UseCenter, UseMouse}; END;|
  2804.    8: SwitchConfig (UseGrowbox);|
  2805.    ELSE  (* Nix *);
  2806.   END;
  2807.  END;
  2808. END DoConfig; 
  2809. *)
  2810.  
  2811. (*----------------------------------------------------------------------*
  2812.  *                      Das "etwas andere" form_do                      *
  2813.  *----------------------------------------------------------------------*)
  2814.  
  2815. CONST NoObject = 32765;
  2816.  
  2817. PROCEDURE Scankey (tree: ADDRESS; scan: sINTEGER; kbshift: sBITSET;
  2818.                    VAR ob: sINTEGER; VAR act: BOOLEAN);
  2819. (* Nach Shortcut und Userkey scannen *)
  2820. VAR (*$Reg*)  i: sINTEGER;
  2821.     d: DIALOG; 
  2822. BEGIN
  2823.  d:= GetDIALOG (tree);  i:= 0;  ob:= NoObject;  act:= FALSE;
  2824.  CASE scan OF
  2825.   103, 104, 105: scan:= scan - 95;|
  2826.   106, 107, 108: scan:= scan - 101;|
  2827.   109, 110, 111: scan:= scan - 107;|
  2828.   112:           scan:= 11; (* 0 *)|
  2829.   120..132:      scan:= scan - 118;|
  2830.   ELSE ;
  2831.  END;
  2832.  (* Bei Shift-Tasten nicht unterscheiden *)
  2833.  IF (Bit0 IN kbshift) OR (Bit1 IN kbshift) THEN
  2834.   kbshift:= kbshift + {Bit0, Bit1};
  2835.  END;
  2836.  WITH d^ DO
  2837.   LOOP 
  2838.    IF (keys[i].scan = -1) THEN  EXIT;  END; (* End of List *)
  2839.    (* Testen, ob dieses Objekt gemeint war *)
  2840.    IF (keys[i].scan = scan) AND (keys[i].kbstate = kbshift) THEN
  2841.     (* K”nnte es sein *)
  2842.     IF (keys[i].object < 0) OR 
  2843.        (~InState (tree, keys[i].object, DISABLED)
  2844.         & ~InFlag (tree, keys[i].object, HIDETREE))
  2845.     THEN
  2846.      ob:= keys[i].object;  act:= keys[i].action;
  2847.      EXIT;
  2848.     END;
  2849.    END;
  2850.    INC (i);
  2851.   END; (* LOOP *)
  2852.  END; (* WITH *)
  2853. END Scankey;
  2854.  
  2855. (*-------------------------------------------------------------------------*)
  2856. (*-                                                                       -*)
  2857. (*- Event abarbeiten -> TRUE: Objekt erwischt                             -*)
  2858. (*-                                                                       -*)
  2859. (*-------------------------------------------------------------------------*)
  2860. PROCEDURE HandleEvent (event : sBITSET;
  2861.                        VAR x, y: sINTEGER;
  2862.                        VAR button: sBITSET;
  2863.                        VAR taste: sINTEGER;
  2864.                        VAR kstate: sBITSET;
  2865.                        VAR scan: sINTEGER;
  2866.                        VAR ascii: CHAR;
  2867.                        VAR clicks: sINTEGER;
  2868.                        tree: ADDRESS;
  2869.                        editable : BOOLEAN;
  2870.                        VAR edit : sINTEGER;
  2871.                        VAR pos : sINTEGER;
  2872.                        VAR entry : sINTEGER
  2873.                        ): BOOLEAN;
  2874.  
  2875. VAR  dial  :          DIALOG;
  2876.      kret, key, nxt, i, typ, cx, cy, ex : sINTEGER;
  2877.      user : sBITSET;
  2878.      action : BOOLEAN;
  2879.  
  2880.  PROCEDURE ChangeEdit (eintrag: sINTEGER);
  2881.  BEGIN
  2882.   IF editable THEN
  2883.    ObjcEdit (tree, edit, pos, 0, EDEND);
  2884.    IF eintrag # edit THEN  edit:= eintrag;  insMode:= TRUE;  END;
  2885.    ObjcEdit (tree, edit, pos, 0, EDINIT);
  2886.   END;
  2887.  END ChangeEdit;
  2888.  
  2889.   BEGIN
  2890.    nxt := edit;
  2891.    kbshift := kstate;
  2892.    dial:= GetDIALOG (tree);
  2893.    IF dial = NIL THEN
  2894. (*    RETURN FALSE;*)
  2895.     HALT;  (* darf eigentlich nicht passieren *)
  2896.    ELSE
  2897.  
  2898.     WITH dial^ DO
  2899.       (* Userhandler aufrufen *)
  2900.       IF (cUser IN flags) THEN
  2901.        IF (pmode = CallByEvent) OR
  2902.           ((pmode = CallByTimer) AND (MUTIMER IN event)) OR
  2903.           ((pmode = CallByRect) AND (MUM1 IN event)) OR
  2904.           ((pmode = CallByMessage) AND (MUMESAG IN event)) THEN
  2905.         user:= proc (tree, mX, mY, scan, kbshift, event, edit);
  2906.         IF user # {} THEN  entry:= -1;  RETURN TRUE; END;
  2907.        END;
  2908.       END; (* IF cUser *)
  2909.  
  2910.       (*--- Objekt mit Maustaste gew„hlt? ---*)
  2911.       IF (MUBUTTON IN event) THEN
  2912.  
  2913.        IF (MRechts IN button) (* OR ((MLinks IN button) AND (kbshift # {})) *) THEN
  2914.         (* Dialog durchsichtig machen *)
  2915.         IF (MRechts IN button) THEN
  2916.          entry:= ObjcFind (tree, 0, 8, mX, mY);
  2917.          IF entry >= 0 THEN  GetObjcExtype (tree, entry, ex, typ);
  2918.                        ELSE  ex:= -1;
  2919.          END;
  2920.         ELSE
  2921.          ex:= MoveBox
  2922.         END;
  2923.         IF ex = MoveBox THEN
  2924.          IF editable THEN  ObjcEdit (tree, edit, pos, 0, EDEND);  END;
  2925.          hideDial (tree);  entry:= -1;
  2926.          IF editable THEN  ObjcEdit (tree, edit, pos, 0, EDINIT);  END;
  2927.         END;
  2928.  
  2929.        ELSIF MLinks IN button THEN
  2930.  
  2931.         (* Mit gedrckter Maustaste in einen Button fahren zulassen *)
  2932.         LOOP
  2933.          MagicAES.GrafMkstate (mX, mY, button, kbshift);
  2934.          entry:= ObjcFind (tree, 0, MAX(sINTEGER), mX, mY);
  2935.          IF NOT (MLinks IN button) THEN
  2936.           (* Corrected by Steffen Engel *)
  2937.           IF (entry > 0) AND (DISABLED IN tree^[entry].obState) THEN
  2938.            entry:= 0;
  2939.           END;
  2940.           EXIT;
  2941.          END;
  2942.          IF entry < 0 THEN
  2943.           Glocke;
  2944.          ELSE
  2945.           GetObjcExtype (tree, entry, ex, typ);
  2946.           IF NOT (DISABLED IN tree^[entry].obState) THEN
  2947.            IF ((ex = MoveBox) OR
  2948.                (SELECTABLE IN tree^[entry].obFlags) OR
  2949.                (Exit IN tree^[entry].obFlags) OR
  2950.                (TOUCHEXIT IN tree^[entry].obFlags)) THEN EXIT;
  2951.            END; (* IF ((ex = MoveBox) *)
  2952.           END; (* IF NOT *)
  2953.          END; (* IF entry < 0 *)
  2954.         END; (* LOOP *)
  2955.  
  2956.         IF entry < 0 THEN (* Ausserhalb *)
  2957.          Glocke;
  2958.  
  2959.         ELSE (* Moveobjekt angeklickt? *)
  2960.          GetObjcExtype (tree, entry, ex, typ);
  2961.          IF ex = MoveBox THEN
  2962.           IF editable THEN  ObjcEdit (tree, edit, pos, 0, EDEND);  END;
  2963.           IF clicks > 1 THEN  (* DoConfig (tree, mX, mY); *)
  2964.                         ELSE  moveDial (tree, mX, mY);
  2965.           END;
  2966.           IF editable THEN  ObjcEdit (tree, edit, pos, 0, EDINIT);  END;
  2967.           entry:= -1;
  2968.  
  2969.          ELSE (* Anderes Objekt erwischt *)
  2970.  
  2971.           IF (EDITABLE IN tree^[entry].obFlags)
  2972.                 (* nur wenn es kein Fensterdialog oder oberstes Fenster ist *)
  2973.           THEN  (* Edit-Cursor plazieren *)
  2974.             IF IsMagiCScroll
  2975.             THEN
  2976.               ChangeEdit (entry);
  2977.             ELSE
  2978.             (*
  2979.             IF UseEdit IN Config
  2980.             THEN
  2981.             *)
  2982.               UpdateEdobj (tree, entry);
  2983.               cx:= JustPos ();
  2984.               IF insMode
  2985.               THEN
  2986.                 pos:= (mX - cx + wbox DIV 2) DIV wbox;
  2987.               ELSE
  2988.                 pos:= (mX - cx) DIV wbox;
  2989.               END;
  2990.               (* Ge„ndert, arbeitete direkt auf dem Baum und rechnete nicht
  2991.                * mit Userdef-Editable
  2992.                *)
  2993.               IF pos > spec^.teTmplen - 1  THEN 
  2994.                 pos:= spec^.teTmplen - 1;
  2995.               END;
  2996.               pos:= GetCursor (pos, i, TRUE);
  2997.             END; (* IF UseEdit *)
  2998.             ChangeEdit (entry);
  2999.           END;
  3000.  
  3001.           IF MagicAES.FormButton  (tree, entry, clicks, nxt) = 0
  3002.           THEN
  3003.             RETURN TRUE;
  3004.           END;
  3005.  
  3006.          END; (* IF ex = MoveBox *)
  3007.         END; (* IF entry >= 0 *)
  3008.        END; (* IF MRechts *)
  3009.       END; (* IF MUBUTTON *)
  3010.  
  3011.       (*--- Objekt mit Tastatur gew„hlt ---*)
  3012.       IF MUKEYBD IN event
  3013.       THEN
  3014.         (* Erst Scankey abfragen. Haben Vorrang!!! *)
  3015.         Scankey (tree, scan, kbshift, entry, action);
  3016.         IF ~editable & (entry = NoObject)
  3017.         THEN
  3018.           (* Buttons in Dialogen ohne Editfelder sind auch mit 
  3019.            * ohne Sondertaste bedienbar
  3020.            *)
  3021.           kbshift := kbshift + ShortKey;
  3022.           Scankey (tree, scan, kbshift, entry, action);
  3023.           kbshift := kstate;
  3024.           (* kbshift wieder restaurieren, wird m”glicherweise noch 
  3025.            * gebraucht 
  3026.            *)
  3027.         END;
  3028.         
  3029.         IF (entry < 0)
  3030.         THEN
  3031.           RETURN TRUE;
  3032.         ELSIF (entry = NoObject)
  3033.         THEN
  3034.           (* vielleicht Editeingabe? *)
  3035.           IF edit < 0 THEN  (* Workaround fr Mag!X *)
  3036.             kret:= FormKeybd (tree, 0, taste, nxt, key);
  3037.           ELSE
  3038.             kret:= FormKeybd (tree, edit, taste, nxt, key);
  3039.           END;
  3040.           IF kret > 0
  3041.           THEN
  3042.             IF nxt > 0
  3043.             THEN
  3044.               IF UseEdit IN Config
  3045.               THEN
  3046.                 pos:= -1;
  3047.               END;
  3048.               ChangeEdit (nxt);
  3049.               IF editable
  3050.               THEN
  3051.                 entry := edit;
  3052.               ELSE
  3053.                 entry := -1;
  3054.               END;
  3055.             ELSIF key > 0
  3056.             THEN
  3057.               IF editable
  3058.               THEN
  3059.                 ObjcEdit (tree, edit, pos, key, EDCHAR);
  3060.                 entry := edit;
  3061.               ELSE
  3062.                 entry := -1;
  3063.               END;
  3064.             END; (* IF nxt > 0 *)
  3065.           ELSE
  3066.             entry := nxt;
  3067.             RETURN TRUE;
  3068.           END; (* IF kret > 0 *)
  3069.         ELSE
  3070.           IF action
  3071.           THEN
  3072.             IF MagicAES.FormButton  (tree, entry, 1, nxt) = 0
  3073.             THEN
  3074.               RETURN TRUE;
  3075.             END;
  3076.           ELSE
  3077.             RETURN TRUE;
  3078.           END;
  3079.         END; (* IF entry < 0 *)
  3080.       END; (* IF MUBKEYBRD *)
  3081.  
  3082.       (* Userhandler aufrufen *)
  3083.       IF (cUser IN flags) AND (pmode = CallByHandling)
  3084.         THEN
  3085.           user:= proc (tree, mX, mY, scan, kbshift, event, edit);
  3086.           IF user # {}
  3087.             THEN
  3088.               entry:= -1;
  3089.               RETURN TRUE;
  3090.             END;
  3091.         END;
  3092.  
  3093.     END; (* WITH dial^ *)
  3094.  
  3095.     RETURN FALSE; (* nix gefunden *)
  3096.  
  3097.    END; (* IF Dial # NIL *)
  3098.   END HandleEvent;
  3099.  
  3100.  
  3101. PROCEDURE PrepDial (    tr        : ADDRESS;
  3102.                         start     : sINTEGER;
  3103.                     VAR editable  : BOOLEAN;
  3104.                     VAR pos, edit : sINTEGER);
  3105. CONST   Undo =     97;
  3106.         Help =     98;
  3107.         Enter =    114;
  3108.         Return =    28;
  3109. VAR i    : sINTEGER;
  3110.     t    : tObjcTree;
  3111.  
  3112.   BEGIN
  3113.    t := tr;
  3114.    (*
  3115.    (* Default-Userkeys eintragen *)
  3116.    i:= ScanFlags (t, SearchFlags, 0, DEFAULT);
  3117.    IF i >= 0 THEN
  3118.     SetUserkey (t, i, Enter,  {}, TRUE, TRUE); (* Enter *)
  3119.     SetUserkey (t, i, Return, {}, TRUE, TRUE); (* Return *)
  3120.    END;
  3121.    *)
  3122.    i:= ScanFlags (t, SearchFlags, 0, UndoButton);
  3123.    IF i >= 0 THEN  SetUserkey (t, i, Undo, {}, TRUE, TRUE);  END;
  3124.    i:= ScanFlags (t, SearchFlags, 0, HelpButton);
  3125.    IF i >= 0 THEN  SetUserkey (t, i, Help, {}, TRUE, TRUE);  END;
  3126.  
  3127.    IF start < 0 THEN (* Sicher kein Editfeld *)
  3128.     edit:= -1;  editable:= FALSE;
  3129.    ELSIF NOT (EDITABLE IN t^[start].obFlags) THEN
  3130.     (* Startobjekt ist kein Editfeld; Suchen! *)
  3131.     edit:= ScanFlags (t, SearchFlags, 0, EDITABLE);
  3132.     editable:= edit >= 0;
  3133.    ELSE (* šbergebenes Feld ist Editfeld *)
  3134.     edit:= start;  editable:= TRUE;
  3135.    END;
  3136.    pos := -1;
  3137.   END PrepDial;
  3138.  
  3139. (*altes DialDo:
  3140. PROCEDURE DialDo (t: ADDRESS; start: sINTEGER): sINTEGER;
  3141. CONST   Undo =     97;
  3142.         Help =     98;
  3143.         Enter =    114;
  3144.         Return =    28;
  3145. VAR     pos, nxt, i, entry, edit, key, kret, old, cx, cy, tmp, default,
  3146.         ex, typ: sINTEGER;
  3147.         editable, tmpflag, end, normalkey, action:  BOOLEAN;
  3148.         select, user:  sBITSET;
  3149.         dial:          DIALOG;
  3150.  
  3151.  PROCEDURE ChangeEdit (eintrag: sINTEGER);
  3152.  BEGIN
  3153.   IF editable THEN
  3154.    ObjcEdit (t, edit, pos, 0, EDEND);
  3155.    IF eintrag # edit THEN  edit:= eintrag;  insMode:= TRUE;  END;
  3156.    ObjcEdit (t, edit, pos, 0, EDINIT);
  3157.   END;
  3158.  END ChangeEdit;
  3159.  
  3160. BEGIN
  3161.  dial:= GetDIALOG (t);
  3162.  IF dial # NIL THEN
  3163.   WITH dial^ DO
  3164.  
  3165. (*
  3166.    (* Default-Userkeys eintragen *)
  3167.    i:= ScanFlags (t, SearchFlags, 0, DEFAULT);
  3168.    IF i >= 0 THEN
  3169.     SetUserkey (t, i, Enter,  {}, TRUE, TRUE); (* Enter *)
  3170.     SetUserkey (t, i, Return, {}, TRUE, TRUE); (* Return *)
  3171.    END;
  3172. *)   i:= ScanFlags (t, SearchFlags, 0, UndoButton);
  3173.    IF i >= 0 THEN  SetUserkey (t, i, Undo, {}, TRUE, TRUE);  END;
  3174.    i:= ScanFlags (t, SearchFlags, 0, HelpButton);
  3175.    IF i >= 0 THEN  SetUserkey (t, i, Help, {}, TRUE, TRUE);  END;
  3176.    IF UseEdit IN Config THEN  pos:= -1;  END;
  3177.  
  3178.    WindUpdate (BEGMCTRL);  (* Finger von der Maus, AES! *)
  3179.  
  3180.    IF start < 0 THEN (* Sicher kein Editfeld *)
  3181.     edit:= -1;  editable:= FALSE;
  3182.    ELSIF NOT (EDITABLE IN tree^[start].obFlags) THEN 
  3183.     (* Startobjekt ist kein Editfeld; Suchen! *)
  3184.     edit:= ScanFlags (t, SearchFlags, 0, EDITABLE);
  3185.     editable:= edit >= 0;
  3186.    ELSE (* šbergebenes Feld ist Editfeld *)
  3187.     edit:= start;  editable:= TRUE;
  3188.    END;
  3189.  
  3190.    IF editable THEN  ObjcEdit (t, edit, pos, 0, EDINIT);  END;
  3191.    MouseOn;
  3192.  
  3193.    LOOP (* 1 *)
  3194.  
  3195.     entry:= -1;  nxt:= edit;
  3196.     event:= DoEvent (mX, mY, button, taste, kbshift, scan, ascii, clicks, t);
  3197.  
  3198.     (* Userhandler aufrufen *)
  3199.     IF (cUser IN flags) THEN
  3200.      IF (pmode = CallByEvent) OR
  3201.         ((pmode = CallByTimer) AND (MUTIMER IN event)) OR
  3202.         ((pmode = CallByRect) AND (MUM1 IN event)) OR
  3203.         ((pmode = CallByMessage) AND (MUMESAG IN event)) THEN
  3204.       user:= proc (t, mX, mY, scan, kbshift, event, edit);
  3205.       IF user # {} THEN  entry:= -1;  EXIT;  END;
  3206.      END;
  3207.     END; (* IF cUser *)
  3208.  
  3209.     (*--- Objekt mit Maustaste gew„hlt? ---*)
  3210.     IF (MUBUTTON IN event) THEN
  3211.      IF (MRechts IN button) (* OR ((MLinks IN button) AND (kbshift # {})) *) THEN
  3212.       (* Dialog durchsichtig machen *)
  3213. (*      IF (MRechts IN button) THEN *)
  3214.        entry:= ObjcFind (t, 0, 8, mX, mY);
  3215.        IF entry >= 0 THEN  GetObjcExtype (t, entry, ex, typ);
  3216.                      ELSE  ex:= -1;
  3217.        END;
  3218. (*      ELSE
  3219.        ex:= MoveBox 
  3220.       END;          *)
  3221.       IF ex = MoveBox THEN
  3222.        IF editable THEN  ObjcEdit (t, edit, pos, 0, EDEND);  END;
  3223.        hideDial (t);  entry:= -1;
  3224.        IF editable THEN  ObjcEdit (t, edit, pos, 0, EDINIT);  END;
  3225.       END;
  3226.  
  3227.      ELSIF MLinks IN button THEN
  3228.  
  3229.       (* Mit gedrckter Maustaste in einen Button fahren zulassen *)
  3230.       LOOP
  3231.        MagicAES.GrafMkstate (mX, mY, button, kbshift);
  3232.        entry:= ObjcFind (t, 0, MAX(INTEGER), mX, mY);
  3233.        IF NOT (MLinks IN button) THEN
  3234.         (* Corrected by Steffen Engel *)
  3235.         IF (entry > 0) AND (DISABLED IN tree^[entry].obState) THEN
  3236.          entry:= 0;
  3237.         END;
  3238.         EXIT;
  3239.        END;
  3240.        IF entry < 0 THEN
  3241.         Glocke;
  3242.        ELSE
  3243.         GetObjcExtype (t, entry, ex, typ);
  3244.         IF NOT (DISABLED IN tree^[entry].obState) THEN
  3245.          IF (ex = MoveBox) AND (kbshift # {})
  3246.          THEN
  3247.           IF editable THEN  ObjcEdit (t, edit, pos, 0, EDEND);  END;
  3248.           hideDial (t);  entry:= -1;
  3249.           IF editable THEN  ObjcEdit (t, edit, pos, 0, EDINIT);  END;
  3250.          ELSE
  3251.           IF ((ex = MoveBox) OR
  3252.               (SELECTABLE IN tree^[entry].obFlags) OR
  3253.               (Exit IN tree^[entry].obFlags) OR
  3254.               (TOUCHEXIT IN tree^[entry].obFlags)) THEN EXIT;
  3255.           END; (* IF ((ex = MoveBox) *)
  3256.          END;
  3257.         END; (* IF NOT *)
  3258.        END; (* IF entry < 0 *)
  3259.       END; (* LOOP *)
  3260.           
  3261.       IF entry < 0 THEN (* Ausserhalb *)
  3262.        Glocke;
  3263.  
  3264.       ELSE (* Moveobjekt angeklickt? *)
  3265.        GetObjcExtype (t, entry, ex, typ);
  3266.        IF ex = MoveBox THEN
  3267.         IF editable THEN  ObjcEdit (t, edit, pos, 0, EDEND);  END;
  3268.         IF clicks > 1 THEN  (* DoConfig (t, mX, mY); *)
  3269.                       ELSE  moveDial (t, mX, mY);
  3270.         END;
  3271.         IF editable THEN  ObjcEdit (t, edit, pos, 0, EDINIT);  END;
  3272.         entry:= -1;
  3273.  
  3274.        ELSE (* Anderes Objekt erwischt *)
  3275.  
  3276.         IF (EDITABLE IN tree^[entry].obFlags) THEN  (* Edit-Cursor plazieren *)
  3277.          IF UseEdit IN Config THEN
  3278.           UpdateEdobj (t, entry);  cx:= JustPos ();
  3279.           IF insMode THEN  pos:= (mX - cx + wbox DIV 2) DIV wbox;
  3280.                      ELSE  pos:= (mX - cx) DIV wbox;
  3281.           END;
  3282.           
  3283.           (* Ge„ndert, arbeitete direkt auf dem Baum und rechnete nicht
  3284.            * mit Userdef-Editable
  3285.            *)
  3286.           IF pos > spec^.teTmplen - 1  THEN 
  3287.            pos:= spec^.teTmplen - 1;
  3288.           END;
  3289.           pos:= GetCursor (pos, i, TRUE);
  3290.          END; (* IF UseEdit *)
  3291.          ChangeEdit (entry);
  3292.         END;
  3293.  
  3294.         IF MagicAES.FormButton  (t, entry, clicks, nxt) = 0 THEN  EXIT  END;
  3295.  
  3296.        END; (* IF ex = MoveBox *)
  3297.       END; (* IF entry >= 0 *)
  3298.      END; (* IF MRechts *)
  3299.     END; (* IF MUBUTTON *)
  3300.  
  3301.     (*--- Objekt mit Tastatur gew„hlt ---*)
  3302.     IF MUKEYBD IN event THEN
  3303.      (* Erst Scankey abfragen. Haben Vorrang!!! *)
  3304.      Scankey (t, scan, kbshift, entry, action);
  3305.      IF (entry < 0) THEN
  3306.       EXIT;
  3307.      ELSIF (entry = NoObject) THEN
  3308.      (* vielleicht Editeingabe? *)
  3309.       IF edit < 0 THEN  (* Workaround fr Mag!X *)
  3310.         kret:= FormKeybd (t, 0, taste, nxt, key);
  3311.       ELSE
  3312.         kret:= FormKeybd (t, edit, taste, nxt, key);
  3313.       END;
  3314.       IF kret > 0 THEN 
  3315.        IF nxt > 0 THEN
  3316.         IF UseEdit IN Config THEN  pos:= -1;  END;  ChangeEdit (nxt);
  3317.        ELSIF key > 0 THEN 
  3318.         IF editable THEN  ObjcEdit (t, edit, pos, key, EDCHAR);  END;
  3319.        END; (* IF nxt > 0 *)
  3320.       ELSE
  3321.        entry := nxt;
  3322.        EXIT
  3323.       END; (* IF kret > 0 *)
  3324.      ELSE
  3325.       IF action THEN
  3326.        IF MagicAES.FormButton  (t, entry, 1, nxt) = 0 THEN  EXIT  END;
  3327.       ELSE
  3328.        EXIT;
  3329.       END;
  3330.      END; (* IF entry < 0 *)
  3331.     END; (* IF MUBKEYBRD *)
  3332.  
  3333.     (* Userhandler aufrufen *)
  3334.     IF (cUser IN flags) AND (pmode = CallByHandling) THEN
  3335.      user:= proc (tree, mX, mY, scan, kbshift, event, edit);
  3336.      IF user # {} THEN  entry:= -1;  EXIT;  END;
  3337.     END;
  3338.  
  3339.    END; (* LOOP 1 *)
  3340.    IF editable THEN  ObjcEdit (tree, edit, pos, 0, EDEND);  END;
  3341.    IF (MUBUTTON IN event) AND (clicks > 1) THEN
  3342.     (* Doppelklick: Bit15 im Return-Wert setzen *)
  3343.     select:= CastToBitset (entry);
  3344.     INCL (select, Bit15);
  3345.     entry:= CastToInt (select);
  3346.    END;
  3347.    WindUpdate (ENDMCTRL);
  3348.    RETURN entry;
  3349.   END;
  3350.  END;
  3351.  RETURN -1;
  3352. END DialDo;
  3353. *)
  3354.  
  3355. (* neues DialDo: *)
  3356.  
  3357. PROCEDURE InternalDialDo (t: ADDRESS; start: sINTEGER): sINTEGER;
  3358. VAR     pos, i, entry, edit : sINTEGER;
  3359.         editable            : BOOLEAN;
  3360.         dial                : DIALOG;
  3361.         select              : sBITSET;
  3362.  
  3363. BEGIN
  3364.  dial:= GetDIALOG (t);
  3365.  IF dial # NIL THEN
  3366.   WITH dial^ DO
  3367.  
  3368.    PrepDial(t, start, editable, pos, edit);
  3369.    IF editable THEN  ObjcEdit (t, edit, pos, 0, EDINIT);  END;
  3370.  
  3371.    WindUpdate (BEGMCTRL);  (* Finger von der Maus, AES! *)
  3372.  
  3373.    MouseOn;
  3374.  
  3375.    LOOP (* 1 *)
  3376.  
  3377.     entry:= -1;
  3378.     event:= DoEvent (mX, mY, button, taste, kbshift, scan, ascii, clicks, t);
  3379.  
  3380.     IF HandleEvent (event, mX, mY, button, taste, kbshift, scan, ascii, clicks,
  3381.                     t, editable, edit, pos, entry)
  3382.       THEN
  3383.         EXIT;
  3384.       END;
  3385.  
  3386.    END; (* LOOP 1 *)
  3387.  
  3388.    IF editable THEN  ObjcEdit (t, edit, pos, 0, EDEND);  END;
  3389.    IF (MUBUTTON IN event) AND (clicks > 1) THEN
  3390.     (* Doppelklick: Bit15 im Return-Wert setzen *)
  3391.     select:= CastToBitset (entry);
  3392.     INCL (select, Bit15);
  3393.     entry:= CastToInt (select);
  3394.    END;
  3395.    WindUpdate (ENDMCTRL);
  3396.    RETURN entry;
  3397.   END;
  3398.  END;
  3399.  RETURN -1;
  3400. END InternalDialDo;
  3401.  
  3402. PROCEDURE DialDo (t: ADDRESS; start: sINTEGER): sINTEGER;
  3403. BEGIN
  3404.   RETURN dialDo (t, start);
  3405. END DialDo;
  3406.  
  3407. PROCEDURE OverloadDialDo (newDialDo: DialDoProc): DialDoProc;
  3408.   VAR oldDialDo : DialDoProc;
  3409. BEGIN
  3410.   IF newDialDo = DialDoProc (NIL)
  3411.   THEN
  3412.     oldDialDo := InternalDialDo;
  3413.     dialDo := InternalDialDo;
  3414.   ELSE
  3415.     oldDialDo := dialDo;
  3416.     dialDo := newDialDo;
  3417.   END;
  3418.   RETURN oldDialDo;
  3419. END OverloadDialDo;
  3420.  
  3421. PROCEDURE IsOverloadedDialDo (): BOOLEAN;
  3422. BEGIN 
  3423.   RETURN dialDo # InternalDialDo;
  3424. END IsOverloadedDialDo;
  3425.  
  3426. PROCEDURE DisableMenu(menu: ADDRESS; disable : BOOLEAN);
  3427.  
  3428. VAR o, title  : sINTEGER;
  3429.     t         : tObjcTree;
  3430.     n         : ADDRESS;
  3431.  
  3432. BEGIN
  3433.   t:= menu;
  3434.   title:= t^[t^[t^[0].obHead].obHead].obHead; (* Index erster Titel *)
  3435.   o:=  t^[t^[t^[0].obHead].obNext].obHead; (* Index erste Box *)
  3436.   SetState(t, t^[o].obHead, MagicAES.DISABLED, disable); (* ersten Eintrag *)
  3437.  
  3438.   LOOP (* 1 *)
  3439.     IF title > t^[title].obNext THEN  EXIT; (* LOOP 1 *) END;
  3440.     title:= t^[title].obNext;
  3441.     SetState(t, title, MagicAES.DISABLED, disable); (* titel disablen *)
  3442.     ExclState(t, title, MagicAES.SELECTED);         (* deselektieren *)
  3443.   END; (* LOOP 1 *)
  3444.  
  3445.   o := MagicAES.MenuBar(menu, MagicAES.Set);
  3446. END DisableMenu;
  3447.  
  3448.  
  3449. PROCEDURE DialCharTable (VAR ch: CHAR): BOOLEAN;
  3450. (* Ruft einen Standarddialog mit einer Zeichenauswahl auf. 
  3451.  * TRUE: Zeichen wurde ausgew„hlt, steht dann in ch
  3452.  *)
  3453.   VAR tmpCh: CHAR;
  3454.       res  : BOOLEAN;
  3455. BEGIN
  3456.   WindUpdate (BEGMCTRL);
  3457.   res := doAsciiTab (FALSE, tmpCh);
  3458.   WindUpdate (ENDMCTRL);
  3459.   IF res
  3460.   THEN
  3461.     ch := tmpCh;
  3462.   END;
  3463.   RETURN res;
  3464. END DialCharTable;
  3465.  
  3466. (*----------------------------------------------------------------------*
  3467.  *                      Initialisierung des Moduls                      *
  3468.  *----------------------------------------------------------------------*)
  3469.  
  3470. PROCEDURE InitDials;
  3471. CONST 
  3472.     (* Cookies definieren *)
  3473.     MagiXCookie = 'MagX';
  3474.     Magic = 'MagC';
  3475.  
  3476. VAR adr: tObjcTree;
  3477.     b:   BOOLEAN;
  3478.     magIx: BOOLEAN;
  3479.     mgxPtr: POINTER TO RECORD
  3480.                          config_status : LONGCARD;  (* long    config_status; *)
  3481.                          dosvars       : ADDRESS;   (* DOSVARS *dosvars; *)
  3482.                          aesvars       : POINTER TO RECORD (* AESVARS *aesvars; *)
  3483.                        
  3484.                              magic      : LONGCARD; (* muž $87654321 sein         *)
  3485.                              membot     : ADDRESS;  (* Ende der AES- Variablen    *)
  3486.                              aes_start  : ADDRESS;  (* Startadresse               *)
  3487.                              magic2     : LONGCARD; (* ist 'MAGX'                 *)
  3488.                              date       : LONGCARD; (* Erstelldatum               *)
  3489.                              (* Die Struktur geht noch weiter, 
  3490.                               * interessiert uns hier aber nicht
  3491.                               *)
  3492.                            END;
  3493.                        END;
  3494.                             
  3495.  
  3496.     crdate: LONGCARD;
  3497.     dist:       ARRAY [0..4] OF INTEGER;
  3498.     effect:     ARRAY [0..2] OF INTEGER;
  3499.     f, i, j, ch, cw: INTEGER;
  3500.     rsc: RESOURCE;
  3501.     a: RECORD 
  3502.         CASE : INTEGER OF
  3503.         0 : lc : lCARDINAL; |
  3504.         1 : x  : RECORD
  3505.                  v : INTEGER;
  3506.                  s : sBITSET;
  3507.                  END;
  3508.         END;
  3509.        END;
  3510. BEGIN
  3511.  IF init # 30961 THEN
  3512.   (*
  3513.   InqFaceinfo (PrivateWS, i, i, i, dist, effect);
  3514.   ChSize:= dist[4];*) 
  3515.   ChSize := AESFontsize;  ChWidth:= CharWidth;  ROffset:= CharWidth * 3;
  3516.   control7:= ADR (VDIControl[7]);
  3517.   control9:= ADR (VDIControl[9]);
  3518.   ScreenMFDB.fdAddr:= 0;
  3519.   small.x:= 0;  small.y:= 0;  small.w:= 0;  small.h:= 0;
  3520.   screen.x:= DeskX;  screen.y:= DeskY;
  3521.   screen.w:= MaxWidth;  screen.h:= MaxHeight;
  3522.   bound.x:= DeskX;  bound.y:= DeskY;
  3523.   bound.w:= MaxWidth - DeskX;  bound.h:= MaxHeight - DeskY;
  3524.  
  3525.   (* Testen, ob 3D-Mode an ist *)
  3526.   i := MagicAES.ApplGetinfo (MagicAES.AEOBJECTS, f, j, j, j);
  3527.   
  3528.   mode3D := (i = 1) & (f = 1) & (Bitplanes >= 4);
  3529.   
  3530.   IF (i # 1)
  3531.   THEN
  3532.     (* ApplGetinfo ist fehlgeschlagen *)
  3533.     IF (MagicAES.AESGlobal.apVersion >= 0340H)
  3534.      & ~FindCookie (MagiXCookie, a.lc)
  3535.     THEN
  3536.       (* Falcon-TOS und kein MagiC *)
  3537.       mode3D := Bitplanes >= 4;
  3538.     END;
  3539.   END;
  3540.   
  3541.   (* Testen, ob Systemfont proportional ist *)
  3542.   i := MagicAES.ApplGetinfo (MagicAES.AEFONT, j, j, f, j);
  3543.  
  3544.  
  3545.   (* Test auf MagiC *)
  3546.   IF FindCookie (MagiXCookie, mgxPtr)
  3547.    & (mgxPtr # NIL)
  3548.    & (mgxPtr^.aesvars # NIL)
  3549.   THEN
  3550.     (* Scrollende Editfelder? *)
  3551.     (* Format von mgxPtr^.aesvars^.date: ttmmjjjj
  3552.      * Wir brauchen:            jjjjmmtt
  3553.      *)
  3554.     crdate := ( (mgxPtr^.aesvars^.date MOD 65536L) * 65536L) + 
  3555.               (((mgxPtr^.aesvars^.date DIV 65536L) MOD 256L) * 256L) + 
  3556.               (mgxPtr^.aesvars^.date DIV (65536L*256L)) ;
  3557.     IsMagiCScroll := (crdate >= $19950829L);
  3558.     CALLSYS (1, 4201, CADR ("crdate: %lx, mgxDate: %lx"), crdate, mgxPtr^.aesvars^.date);
  3559.   ELSE
  3560.     IsMagiCScroll := FALSE;
  3561.   END;
  3562.   
  3563.  
  3564.   b:= NewAREA (area);
  3565.   Dials:= NIL;  (* InstallTermproc (DisposeDials); Die Dials werden am Programmende sowieso alle freigegeben *)
  3566.   Config:= {UseSolid, UseEdit, UseALT, UseGrowbox, UseConfig, UseCenter};
  3567.   ShortKey:= {KALT};
  3568.  
  3569.   (* ScanCode-Tabelle fr die zul„ssigen Shortcuts ermitteln *)
  3570.   Tastatur:= GetKeytable ();
  3571.   FOR i:= 1 TO 99 DO  (* Nur bis 99, da hier der Ziffernblock beginnt.
  3572.                        * Diese Zeichen werden innerhalb von DialDo umgeleitet.
  3573.                        *)
  3574.    f:= ORD(Tastatur^.capslock^[i]);
  3575.    CASE f OF
  3576.     48..57, 65..90: scancodes[f]:= i;|
  3577.     58..64:         scancodes[f]:= -1;|
  3578.     ELSE
  3579.    END;
  3580.   END;
  3581.  
  3582.   (* Modulinterne Resource laden *) 
  3583.   (* Erstmal Speicher fr Ressource dafr allozieren *)
  3584.   ALLOCATE (rscData, TSIZE (tRscData));
  3585.   IF rscData = NIL THEN HALT END;   (* Kein Speicher fr interne Ressource *)
  3586.   (* Jetzt Resourcedaten kopieren *)
  3587.   rscData^ := RscData;
  3588.   (* Und jetzt relozieren *)
  3589.   IF RelocRsc (rscData, rsc) THEN 
  3590.  
  3591.    asciitab:= GaddrRsc (rsc, MagicAES.RTREE, 0);
  3592.    b:= NewDial (asciitab);  oldPos:= -1;  insMode:= TRUE;
  3593.    confdial:= GaddrRsc (rsc, MagicAES.RTREE, 1);
  3594.    adr:= GaddrRsc (rsc, MagicAES.RTREE, 2);
  3595.   
  3596.    mSelect[FALSE]:= adr^[ 1].obSpec.ImagePtr^.biData;
  3597.    mSelect[TRUE]:=  adr^[ 2].obSpec.ImagePtr^.biData;
  3598.    mKnopf[FALSE]:=  adr^[ 3].obSpec.ImagePtr^.biData;
  3599.    mKnopf[TRUE]:=   adr^[ 4].obSpec.ImagePtr^.biData;
  3600.    mCircle[FALSE]:= adr^[ 5].obSpec.ImagePtr^.biData;
  3601.    mCircle[TRUE]:=  adr^[ 6].obSpec.ImagePtr^.biData;
  3602.    mPunktEin:=      adr^[ 7].obSpec.ImagePtr^.biData;
  3603.    fSelect[FALSE]:= adr^[ 8].obSpec.ImagePtr^.biData;
  3604.    fSelect[TRUE]:=  adr^[ 9].obSpec.ImagePtr^.biData;
  3605.    fKnopf[FALSE]:=  adr^[10].obSpec.ImagePtr^.biData;
  3606.    fKnopf[TRUE]:=   adr^[11].obSpec.ImagePtr^.biData;
  3607.    fCircle[FALSE]:= adr^[12].obSpec.ImagePtr^.biData;
  3608.    fCircle[TRUE]:=  adr^[13].obSpec.ImagePtr^.biData;
  3609.    fPunktEin:=      adr^[14].obSpec.ImagePtr^.biData;
  3610.   
  3611.   ELSE
  3612.    HALT; (* Resource laden fehlgeschlagen!  B”ser Fehler!!! *)
  3613.   END;
  3614.  
  3615.   (* Jetzt nach Cookie suchen und ggf. Einstellungen daraus bernehmen *)
  3616.   IF FindCookie (Magic, a.lc) THEN
  3617.     (* Cookie gefunden *)
  3618.     WITH a.x DO
  3619.       IF v = 00H        (* Versionsnummer im ersten Wort *)
  3620.       THEN
  3621.         Config := s - {7..15} + {UseConfig};
  3622.         (* Nun auf Gltigkeit prfen *)
  3623.         IF {UseCenter, UseMouse, UsePos} * Config = {}
  3624.         THEN
  3625.           INCL (Config, UseCenter);
  3626.         END;
  3627.         IF UseALT IN Config
  3628.         THEN
  3629.           ShortKey:= {KALT};
  3630.         ELSE
  3631.           ShortKey:= {KCTRL};
  3632.         END;
  3633.         
  3634.       END;
  3635.     END (* WITH *)
  3636.   END;
  3637.   INCL (Config, UseEdit);
  3638.  
  3639.   init:= 30961;
  3640.  END;
  3641. END InitDials;
  3642.  
  3643. BEGIN
  3644.  init:= 0;
  3645.  InitDials;
  3646.  dialDo := InternalDialDo;
  3647. END mtDials.
  3648.  
  3649.